#ifndef GITHASH_PP
#define GITHASH_PP "unknown"
#endif
MODULE DUMP

! Create and write ("dump") to various output files

USE PRECISION_PARAMETERS
USE COMP_FUNCTIONS
USE MESH_VARIABLES
USE GLOBAL_CONSTANTS
USE TRAN
USE ISOSMOKE
USE MESH_POINTERS
USE DEVICE_VARIABLES
USE CONTROL_VARIABLES
USE OUTPUT_DATA
USE SOOT_ROUTINES
USE COMPLEX_GEOMETRY, ONLY : WRITE_GEOM, WRITE_GEOM_ALL, WRITE_GEOM_DATA
USE TYPES

IMPLICIT NONE
PRIVATE

INTEGER, PARAMETER :: ONE_INTEGER=1,ZERO_INTEGER=0
REAL(EB), POINTER, DIMENSION(:,:,:) :: WFX=>NULL(),WFY=>NULL(),WFZ=>NULL()
INTEGER :: N_DEVC_FILES
CHARACTER(80) :: TCFORM
LOGICAL :: EX,DRY,OPN,FROM_BNDF=.FALSE.

TYPE (MESH_TYPE), POINTER :: M=>NULL()
TYPE (LAGRANGIAN_PARTICLE_TYPE), POINTER :: LP=>NULL()
TYPE (OBSTRUCTION_TYPE), POINTER :: OB=>NULL()
TYPE (VENTS_TYPE), POINTER :: VT=>NULL()
TYPE (LAGRANGIAN_PARTICLE_CLASS_TYPE), POINTER :: LPC=>NULL()
TYPE (SPECIES_TYPE), POINTER :: SS=>NULL()
TYPE (REACTION_TYPE), POINTER :: RN=>NULL()
TYPE (SURFACE_TYPE),POINTER :: SF=>NULL()
TYPE (MATERIAL_TYPE),POINTER :: ML=>NULL()
TYPE (PROPERTY_TYPE), POINTER :: PY=>NULL()
TYPE (DEVICE_TYPE), POINTER :: DV=>NULL(), DV2=>NULL()
TYPE (SUBDEVICE_TYPE), POINTER :: SDV=>NULL()
TYPE (SLICE_TYPE), POINTER :: SL=>NULL()
TYPE (WALL_TYPE), POINTER :: WC=>NULL()
TYPE (CFACE_TYPE), POINTER :: CFA=>NULL()
TYPE (BOUNDARY_ELEMENT_FILE_TYPE), POINTER :: BE=>NULL()
TYPE (BOUNDARY_FILE_TYPE), POINTER :: BF=>NULL()
TYPE (ISOSURFACE_FILE_TYPE), POINTER :: IS=>NULL()
TYPE (INITIALIZATION_TYPE), POINTER :: IN=>NULL()

PUBLIC ASSIGN_FILE_NAMES,INITIALIZE_GLOBAL_DUMPS,INITIALIZE_MESH_DUMPS,WRITE_STATUS_FILES, &
       TIMINGS,FLUSH_GLOBAL_BUFFERS,FLUSH_EVACUATION_BUFFERS,FLUSH_LOCAL_BUFFERS,READ_RESTART,WRITE_DIAGNOSTICS, &
       WRITE_SMOKEVIEW_FILE,DUMP_MESH_OUTPUTS,UPDATE_GLOBAL_OUTPUTS,DUMP_DEVICES,DUMP_HRR,DUMP_MASS,DUMP_CONTROLS,&
       INITIALIZE_DIAGNOSTIC_FILE,DUMP_RESTART,&
       DUMP_UVW,DUMP_GEOM,DUMP_GEOM_DIAG,UPDATE_DEVICES_2


CONTAINS


SUBROUTINE UPDATE_GLOBAL_OUTPUTS(T,DT,NM)

USE COMP_FUNCTIONS, ONLY : CURRENT_TIME
REAL(EB) :: TNOW
INTEGER, INTENT(IN) :: NM
REAL(EB),INTENT(IN) :: T,DT

TNOW = CURRENT_TIME()

CALL UPDATE_HRR(DT,NM)
CALL UPDATE_MASS(DT,NM)
CALL UPDATE_DEVICES_1(T,DT,NM)

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE UPDATE_GLOBAL_OUTPUTS


SUBROUTINE DUMP_MESH_OUTPUTS(T,DT,NM)

USE COMP_FUNCTIONS, ONLY : CURRENT_TIME
USE EVAC, ONLY : EMESH_NFIELDS, EMESH_EXITS, EVAC_EMESH_EXITS_TYPE, N_EXITS, N_CO_EXITS, N_DOORS, EMESH_INDEX
USE TURBULENCE, ONLY: SANDIA_OUT, SPECTRAL_OUTPUT
IMPLICIT NONE
REAL(EB) :: TNOW, TTMP
REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: NM
CHARACTER(80) :: FN_UVW,FN_MMS,FN_SPEC
LOGICAL :: L_READ_EFF
INTEGER :: NFIELDS, I1, I2, I2_NOW, K, N_END, NN

TNOW = CURRENT_TIME()

EVACUATION_DUMP: IF (EVACUATION_ONLY(NM)) THEN

   IF (.NOT.EMESH_INDEX(NM)>0) RETURN
   ! Dump the EVAC flowfieds for all EVAC meshes

   L_READ_EFF = BTEST(I_EVAC,2) ! Is the EFF file read in or (re)calculated?
   IF (ABS(ICYC)==EVAC_TIME_ITERATIONS) THEN
      TTMP = EVAC_DT_FLOWFIELD*EMESH_NFIELDS(EMESH_INDEX(NM))*EVAC_TIME_ITERATIONS/&
           MAX(1,MAXVAL(EMESH_NFIELDS))
   ELSE
      TTMP = EVAC_DT_FLOWFIELD*EVAC_TIME_ITERATIONS
   END IF
   IF (L_READ_EFF) THEN
      NFIELDS = EMESH_NFIELDS(EMESH_INDEX(NM))
      K = MESHES(NM)%KBAR
      N_END = N_EXITS - N_CO_EXITS + N_DOORS
      DO I1 = 1, NFIELDS
         LOOP_EXITS: DO I2 = 1, N_END
            IF (EMESH_EXITS(I2)%MAINMESH == NM .AND. EMESH_EXITS(I2)%I_DOORS_EMESH == I1) THEN
               I2_NOW = I2
               EXIT LOOP_EXITS
            END IF
         END DO LOOP_EXITS
         MESHES(NM)%U(:,:,K)    = EMESH_EXITS(I2_NOW)%U_EVAC(:,:)
         MESHES(NM)%V(:,:,K)    = EMESH_EXITS(I2_NOW)%V_EVAC(:,:)
         MESHES(NM)%U(:,:,0)    = MESHES(NM)%U(:,:,K)
         MESHES(NM)%V(:,:,0)    = MESHES(NM)%V(:,:,K)
         MESHES(NM)%U(:,:,K+1)  = MESHES(NM)%U(:,:,K)
         MESHES(NM)%V(:,:,K+1)  = MESHES(NM)%V(:,:,K)
         MESHES(NM)%KRES(:,:,:) = 0.5_EB*SQRT(MESHES(NM)%U(:,:,:)**2 + MESHES(NM)%V(:,:,:)**2)
         MESHES(NM)%W(:,:,:)    = 0.0_EB
         TTMP = (NFIELDS - I1 + 1)*EVAC_DT_FLOWFIELD
         CALL DUMP_SLCF(T-TTMP,DT,NM,0)
      END DO
   ELSE
      CALL DUMP_SLCF(T-TTMP,DT,NM,0)
   END IF

ELSE

   IF (T>=PART_CLOCK(NM) .AND. PARTICLE_FILE) THEN
      CALL DUMP_PART(T,NM)
      DO NN=1,CEILING(DT/DT_PART)
         PART_CLOCK(NM) = PART_CLOCK(NM) + DT_PART
         IF (PART_CLOCK(NM)>=T) THEN
            PART_CLOCK(NM) = MIN(PART_CLOCK(NM),T_END)
            EXIT
         ENDIF
      ENDDO
   ENDIF
   IF (T>=ISOF_CLOCK(NM)) THEN
      CALL DUMP_ISOF(T,DT,NM)
      DO NN=1,CEILING(DT/DT_ISOF)
         ISOF_CLOCK(NM) = ISOF_CLOCK(NM) + DT_ISOF
         IF (ISOF_CLOCK(NM)>=T) THEN
            ISOF_CLOCK(NM) = MIN(ISOF_CLOCK(NM),T_END)
            EXIT
         ENDIF
      ENDDO
   ENDIF
   IF (T>=SLCF_CLOCK(NM)) THEN
      CALL DUMP_SLCF(T,DT,NM,0)
      IF (SMOKE3D) CALL DUMP_SMOKE3D(T,DT,NM)
      DO NN=1,CEILING(DT/DT_SLCF)
         SLCF_CLOCK(NM) = SLCF_CLOCK(NM) + DT_SLCF
         IF (SLCF_CLOCK(NM)>=T) THEN
            SLCF_CLOCK(NM) = MIN(SLCF_CLOCK(NM),T_END)
            EXIT
         ENDIF
      ENDDO
   ENDIF
   IF (T>=SL3D_CLOCK(NM) .OR. STOP_STATUS==INSTABILITY_STOP) THEN
      CALL DUMP_SLCF(T,DT,NM,2)
      DO NN=1,CEILING(DT/DT_SL3D)
         SL3D_CLOCK(NM) = SL3D_CLOCK(NM) + DT_SL3D
         IF (SL3D_CLOCK(NM)>=T) THEN
            SL3D_CLOCK(NM) = MIN(SL3D_CLOCK(NM),T_END)
            EXIT
         ENDIF
      ENDDO
   ENDIF
   IF (T>=BNDF_CLOCK(NM)) THEN
      CALL DUMP_BNDF(T,NM)
      IF (TERRAIN_CASE) CALL DUMP_BNDF_TO_SLCF(T,NM)
      DO NN=1,CEILING(DT/DT_BNDF)
         BNDF_CLOCK(NM) = BNDF_CLOCK(NM) + DT_BNDF
         IF (BNDF_CLOCK(NM)>=T) THEN
            BNDF_CLOCK(NM) = MIN(BNDF_CLOCK(NM),T_END)
            EXIT
         ENDIF
      ENDDO
   ENDIF
   IF (T>=PL3D_CLOCK(NM) .OR. STOP_STATUS==INSTABILITY_STOP) THEN
      CALL DUMP_SLCF(T,DT,NM,1)
      DO NN=1,CEILING(DT/DT_PL3D)
         PL3D_CLOCK(NM) = PL3D_CLOCK(NM) + DT_PL3D
         IF (PL3D_CLOCK(NM)>=T) THEN
            PL3D_CLOCK(NM) = MIN(PL3D_CLOCK(NM),T_END)
            EXIT
         ENDIF
      ENDDO
   ENDIF
   IF (T>=PROF_CLOCK(NM)) THEN
      CALL DUMP_PROF(T,NM)
      DO NN=1,CEILING(DT/DT_PROF)
         PROF_CLOCK(NM) = PROF_CLOCK(NM) + DT_PROF
         IF (PROF_CLOCK(NM)>=T) THEN
            PROF_CLOCK(NM) = MIN(PROF_CLOCK(NM),T_END)
            EXIT
         ENDIF
      ENDDO
   ENDIF
   IF (T>=UVW_TIMER(MESHES(NM)%IUVW)) THEN
      IF (NMESHES>1) THEN
         WRITE(FN_UVW,'(A,A,I3.3,A,I3.3,A)') TRIM(CHID),'_uvw_t',MESHES(NM)%IUVW,'_m',NM,'.csv'
      ELSE
         WRITE(FN_UVW,'(A,A,I3.3,A)') TRIM(CHID),'_uvw_',MESHES(NM)%IUVW,'.csv'
      ENDIF
      CALL DUMP_UVW(NM,FN_UVW)
      MESHES(NM)%IUVW = MESHES(NM)%IUVW + 1
   ENDIF
   PERIODIC_TEST_SELECT: SELECT CASE(PERIODIC_TEST)
      CASE(2)
         IF (T>=UVW_CLOCK_CBC(MESHES(NM)%IUVW)) THEN
            WRITE(FN_UVW,'(A,A,I3.3,A)') TRIM(CHID),'_uvw_',MESHES(NM)%IUVW,'.csv'
            CALL DUMP_UVW(NM,FN_UVW)
            MESHES(NM)%IUVW = MESHES(NM)%IUVW + 1
         ENDIF
      CASE(7,11)
         IF (T>=MMS_TIMER .AND. NM==1) THEN
            WRITE(FN_MMS,'(A,A)') TRIM(CHID),'_mms.csv'
            CALL DUMP_MMS(NM,FN_MMS,T)
            MMS_TIMER=HUGE_EB
         ENDIF
      CASE(9)
         IF (T>=UVW_CLOCK_CBC(MESHES(NM)%IUVW)) THEN
            WRITE(FN_SPEC,'(A,A,I3.3,A)') TRIM(CHID),'_spec_',MESHES(NM)%IUVW,'.csv'
            CALL SPECTRAL_OUTPUT(NM,FN_SPEC)
            MESHES(NM)%IUVW = MESHES(NM)%IUVW + 1
         ENDIF
         IF (T>=TURB_INIT_CLOCK) THEN
            TURB_INIT_CLOCK=HUGE_EB ! only write ini_salsa.dat file once
            CALL SANDIA_OUT(NM)
         ENDIF
   END SELECT PERIODIC_TEST_SELECT

ENDIF EVACUATION_DUMP

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE DUMP_MESH_OUTPUTS


SUBROUTINE ASSIGN_FILE_NAMES

! Assign names and logical units for all output files

USE COMP_FUNCTIONS
USE EVAC, ONLY : EMESH_INDEX
INTEGER :: NM,I,N
CHARACTER(LABEL_LENGTH) :: CFORM

! Set up file number counter

ALLOCATE(FILE_COUNTER(0:N_MPI_PROCESSES))
FILE_COUNTER = 10

! Endian File

FN_END = TRIM(CHID)//'.end'

! GIT ID file

FN_GIT = TRIM(CHID)//'_git.txt'

! Smokeview File

FN_SMV = TRIM(CHID)//'.smv'
LU_INFO  = GET_FILE_NUMBER()

! Diagnostic Output File

FN_OUTPUT = TRIM(CHID)//'.out'
IF (.NOT.OVERWRITE) THEN
   INQUIRE(FILE=FN_OUTPUT,EXIST=EX)
   IF (EX) THEN
      WRITE(LU_ERR,'(A,A,A)')  'ERROR: OVERWRITE=.FALSE. and the file ',TRIM(FN_OUTPUT),' exists.'
      STOP
   ENDIF
ENDIF

! Mass and HRR Files

IF (MASS_FILE) THEN
   LU_MASS  = GET_FILE_NUMBER()
   FN_MASS  = TRIM(CHID)//'_mass.csv'
ENDIF

LU_HRR   = GET_FILE_NUMBER()
FN_HRR   = TRIM(CHID)//'_hrr.csv'

! Device and Control Files

IF (N_PDPA_HISTOGRAM>0) THEN
        LU_HISTOGRAM=GET_FILE_NUMBER()
        FN_HISTOGRAM=TRIM(CHID)//'_hist.csv'
ENDIF


IF (COLUMN_DUMP_LIMIT) THEN
   N_DEVC_FILES = N_DEVC_TIME / DEVC_COLUMN_LIMIT
   IF (N_DEVC_FILES * DEVC_COLUMN_LIMIT < N_DEVC_TIME) N_DEVC_FILES = N_DEVC_FILES + 1
   N_CTRL_FILES = N_CTRL / CTRL_COLUMN_LIMIT
   IF (N_CTRL_FILES * CTRL_COLUMN_LIMIT < N_CTRL) N_CTRL_FILES = N_CTRL_FILES + 1
ELSE
   IF (N_DEVC_TIME >= 1) THEN
      N_DEVC_FILES = 1
      DEVC_COLUMN_LIMIT = N_DEVC_TIME
   ENDIF
   IF (N_CTRL >= 1) THEN
      N_CTRL_FILES = 1
      CTRL_COLUMN_LIMIT = N_CTRL
   ENDIF
ENDIF

ALLOCATE(LU_DEVC(N_DEVC_FILES))
ALLOCATE(FN_DEVC(N_DEVC_FILES))
ALLOCATE(LU_CTRL(N_CTRL_FILES))
ALLOCATE(FN_CTRL(N_CTRL_FILES))

DO I=1,N_DEVC_FILES
   LU_DEVC(I) = GET_FILE_NUMBER()
   WRITE(FN_DEVC(I),'(A,A,I0,A)') TRIM(CHID),'_',I,'_devc.csv'
ENDDO
IF (N_DEVC_FILES==1) FN_DEVC(1) = TRIM(CHID)//'_devc.csv'

DO I=1,N_CTRL_FILES
   LU_CTRL(I) = GET_FILE_NUMBER()
   WRITE(FN_CTRL(I),'(A,A,I0,A)') TRIM(CHID),'_',I,'_ctrl.csv'
ENDDO
IF (N_CTRL_FILES==1) FN_CTRL(1) = TRIM(CHID)//'_ctrl.csv'

! Line files

IF (N_DEVC_LINE>0) THEN
   LU_LINE = GET_FILE_NUMBER()
   FN_LINE = TRIM(CHID)//'_line.csv'
ENDIF

! Profile Files

ALLOCATE(LU_PROF(N_PROF))
ALLOCATE(FN_PROF(N_PROF))

DO N=1,N_PROF
   LU_PROF(N) = GET_FILE_NUMBER()
   IF (N_PROF <100) CFORM = '(A,A,I2.2,A)'
   IF (N_PROF>=100) CFORM = '(A,A,I3.3,A)'
   WRITE(FN_PROF(N),CFORM) TRIM(CHID),'_prof_',N,'.csv'
ENDDO

! Plot3D

ALLOCATE(FN_XYZ(NMESHES))
ALLOCATE(LU_XYZ(NMESHES))
ALLOCATE(FN_PL3D(NMESHES))
ALLOCATE(LU_PL3D(NMESHES))

ALLOCATE(FN_ISOF(N_ISOF,NMESHES))
ALLOCATE(LU_ISOF(N_ISOF,NMESHES))
ALLOCATE(FN_ISOF2(N_ISOF,NMESHES))
ALLOCATE(LU_ISOF2(N_ISOF,NMESHES))
ALLOCATE(FN_SLCF(N_SLCF_MAX,NMESHES))
ALLOCATE(LU_SLCF(N_SLCF_MAX,NMESHES))
ALLOCATE(FN_SLCF_GEOM(N_SLCF_MAX,NMESHES))
ALLOCATE(LU_SLCF_GEOM(N_SLCF_MAX,NMESHES))
ALLOCATE(FN_GEOM(1)) ! later each geometry group may have a separate file
ALLOCATE(LU_GEOM(1))
ALLOCATE(FN_BNDE(N_BNDE))
ALLOCATE(LU_BNDE(N_BNDE))
ALLOCATE(FN_BNDF(N_BNDF,NMESHES))
ALLOCATE(LU_BNDF(N_BNDF,NMESHES))
IF (CC_IBM) THEN
   ALLOCATE(FN_BNDF_GEOM(N_BNDF,NMESHES))
   ALLOCATE(LU_BNDF_GEOM(N_BNDF,NMESHES))
   ALLOCATE(FN_BNDG(N_BNDF,NMESHES))
   ALLOCATE(LU_BNDG(N_BNDF,NMESHES))
ENDIF
IF (N_RADF>0) THEN
   ALLOCATE(FN_RADF(N_RADF,NMESHES))
   ALLOCATE(LU_RADF(N_RADF,NMESHES))
ENDIF
IF (TERRAIN_CASE) THEN
   ALLOCATE(FN_BNDF_SLCF(N_BNDF,NMESHES))
   ALLOCATE(LU_BNDF_SLCF(N_BNDF,NMESHES))
ENDIF
ALLOCATE(FN_SMOKE3D(8,NMESHES)) ! also allocate unit numbers and file names for the size files
ALLOCATE(LU_SMOKE3D(8,NMESHES))
ALLOCATE(FN_PART(NMESHES))
ALLOCATE(LU_PART(NMESHES))
ALLOCATE(FN_CORE(NMESHES))
ALLOCATE(LU_CORE(NMESHES))
ALLOCATE(FN_RESTART(NMESHES))
ALLOCATE(LU_RESTART(NMESHES))

MESH_LOOP: DO NM=1,NMESHES

   IF (PROCESS(NM)/=MYID) CYCLE MESH_LOOP

   M => MESHES(NM)

   ! Plot3D Files

   LU_XYZ(NM)  = GET_FILE_NUMBER()
   LU_PL3D(NM) = GET_FILE_NUMBER()
   IF (NMESHES >1) WRITE(FN_XYZ(NM),'(A,A,I4.4,A)') TRIM(CHID),'_',NM,'.xyz'
   IF (NMESHES==1) WRITE(FN_XYZ(NM),'(A,A)')        TRIM(CHID),       '.xyz'

   ! Iso Surface Files

   ! Allocate unit numbers and file names for isosurface files
   ! The unit numbers are intially negative so that the isosurface output
   ! routine "knows" when it is called the first time

   DO N=1,N_ISOF
      LU_ISOF(N,NM) = -GET_FILE_NUMBER()
      IF (RESTART) LU_ISOF(N,NM) = ABS(LU_ISOF(N,NM))
      LU_ISOF2(N,NM) = -GET_FILE_NUMBER()
      IF (RESTART) LU_ISOF2(N,NM) = ABS(LU_ISOF2(N,NM))
      IF (NMESHES >1) WRITE(FN_ISOF(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'.iso'
      IF (NMESHES==1) WRITE(FN_ISOF(N,NM),'(A,A,I2.2,A)')        TRIM(CHID),'_',N,'.iso'
      IF (NMESHES >1) WRITE(FN_ISOF2(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'.viso'
      IF (NMESHES==1) WRITE(FN_ISOF2(N,NM),'(A,A,I2.2,A)')        TRIM(CHID),'_',N,'.viso'
   ENDDO

   ! Allocate unit numbers and file names for 3d smoke files
   ! The unit numbers are intially negative so that the 3d smoke output
   ! routine "knows" when it is called the first time

   DO N=1,4
      IF (SMOKE3D_QUANTITY_INDEX(N)==0) CYCLE
      LU_SMOKE3D(N,NM) = -GET_FILE_NUMBER()
      IF (RESTART) LU_SMOKE3D(N,NM) = ABS(LU_SMOKE3D(N,NM))
      IF (NMESHES >1) WRITE(FN_SMOKE3D(N,NM),  '(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'.s3d'
      IF (NMESHES==1) WRITE(FN_SMOKE3D(N,NM),  '(A,A,I2.2,A)')        TRIM(CHID),'_',N,'.s3d'
      LU_SMOKE3D(N+4,NM) = -GET_FILE_NUMBER()
      IF (RESTART) LU_SMOKE3D(N+4,NM) = ABS(LU_SMOKE3D(N+4,NM))
      IF (NMESHES >1) WRITE(FN_SMOKE3D(N+4,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'.s3d.sz'
      IF (NMESHES==1) WRITE(FN_SMOKE3D(N+4,NM),'(A,A,I2.2,A)')        TRIM(CHID),'_',N,'.s3d.sz'
   ENDDO

   ! Slice Files

   DO N=1,M%N_SLCF
      LU_SLCF(N,NM) = GET_FILE_NUMBER()
      LU_SLCF_GEOM(N,NM) = GET_FILE_NUMBER()
      IF (NMESHES>1) THEN
         IF (M%N_SLCF <100) CFORM = '(A,A,I4.4,A,I2.2,A)'
         IF (M%N_SLCF>=100) CFORM = '(A,A,I4.4,A,I3.3,A)'
         WRITE(FN_SLCF(N,NM),CFORM) TRIM(CHID),'_',NM,'_',N,'.sf'
         WRITE(FN_SLCF_GEOM(N,NM),CFORM) TRIM(CHID),'_',NM,'_',N,'.gsf'
      ELSE
         IF (M%N_SLCF <100) CFORM = '(A,A,I2.2,A)'
         IF (M%N_SLCF>=100) CFORM = '(A,A,I3.3,A)'
         WRITE(FN_SLCF(N,NM),CFORM) TRIM(CHID),'_',N,'.sf'
         WRITE(FN_SLCF_GEOM(N,NM),CFORM) TRIM(CHID),'_',N,'.gsf'
      ENDIF
   ENDDO

   ! Radiation Files

   DO N=1,M%N_RADF
      LU_RADF(N,NM) = GET_FILE_NUMBER()
      IF (NMESHES>1) THEN
         IF (M%N_RADF <100) CFORM = '(A,A,I4.4,A,I2.2,A)'
         IF (M%N_RADF>=100) CFORM = '(A,A,I4.4,A,I3.3,A)'
         WRITE(FN_RADF(N,NM),CFORM) TRIM(CHID),'_radf_',NM,'_',N,'.txt'
      ELSE
         IF (M%N_RADF <100) CFORM = '(A,A,I2.2,A)'
         IF (M%N_RADF>=100) CFORM = '(A,A,I3.3,A)'
         WRITE(FN_RADF(N,NM),CFORM) TRIM(CHID),'_radf_',N,'.txt'
      ENDIF
   ENDDO

   ! Boundary Files

   DO N=1,N_BNDF
      LU_BNDF(N,NM) = GET_FILE_NUMBER()
      IF(CC_IBM) THEN
         LU_BNDF_GEOM(N,NM) = GET_FILE_NUMBER()
         LU_BNDG(N,NM) = GET_FILE_NUMBER()
      ENDIF
      IF (NMESHES>1) THEN
         WRITE(FN_BNDF(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'.bf'
         IF (CC_IBM) THEN
            WRITE(FN_BNDF_GEOM(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'.gbf'
            WRITE(FN_BNDG(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'.be'
         ENDIF
      ELSE
         WRITE(FN_BNDF(N,NM),'(A,A,I2.2,A)') TRIM(CHID),'_',N,'.bf'
         IF (CC_IBM) THEN
            WRITE(FN_BNDF_GEOM(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',N,'.gbf'
            WRITE(FN_BNDG(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',N,'.be'
         ENDIF
      ENDIF
   ENDDO

   ! Boundary Files mapped to slice files for terrain cases

   IF (TERRAIN_CASE) THEN
      DO N=1,N_BNDF
         LU_BNDF_SLCF(N,NM) = GET_FILE_NUMBER()
         IF (NMESHES>1) THEN
            WRITE(FN_BNDF_SLCF(N,NM),'(A,A,I4.4,A,I2.2,A)') TRIM(CHID),'_',NM,'_',N,'_bf.sf'
         ELSE
            WRITE(FN_BNDF_SLCF(N,NM),'(A,A,I2.2,A)') TRIM(CHID),'_',N,'_bf.sf'
         ENDIF
      ENDDO
   ENDIF

   ! Particle Files

   IF (PARTICLE_FILE .AND. .NOT.EVACUATION_ONLY(NM)) THEN
      LU_PART(NM) = GET_FILE_NUMBER()
      IF (NMESHES>1) THEN
         WRITE(FN_PART(NM),'(A,I4.4,A)') TRIM(CHID)//'_',NM,'.prt5'
      ELSE
         WRITE(FN_PART(NM),'(A,A)') TRIM(CHID),'.prt5'
      ENDIF
   ENDIF

   ! Particle Files for Evacuation

   IF (EVACUATION_ONLY(NM)) THEN
      IF (EMESH_INDEX(NM)>0) THEN
         LU_PART(NM) = GET_FILE_NUMBER()
         IF (NMESHES>1) THEN
            WRITE(FN_PART(NM),'(A,I4.4,A)') TRIM(CHID)//'_',NM,'.prt5'
         ELSE
            WRITE(FN_PART(NM),'(A,A)') TRIM(CHID),'.prt5'
         ENDIF
      END IF
   ENDIF

   ! Restart Files

   LU_RESTART(NM) = GET_FILE_NUMBER()
   WRITE(FN_RESTART(NM),'(A,A,I4.4,A)') TRIM(RESTART_CHID),'_',NM,'.restart'
   LU_CORE(NM)    = GET_FILE_NUMBER()
   WRITE(FN_CORE(NM),   '(A,A,I4.4,A)') TRIM(CHID),'_',NM,'.restart'

ENDDO MESH_LOOP

! Boundary Element Files

DO N=1,N_BNDE
   LU_BNDE(N) = GET_FILE_NUMBER()
   WRITE(FN_BNDE(N),'(A,A,I2.2,A)') TRIM(CHID),'_',N,'.be'
ENDDO

! Unstructured Geometry Files

IF (N_FACE>0 .OR. N_GEOMETRY>0) THEN
   DO N=1,1
      LU_GEOM(N) = GET_FILE_NUMBER()
      WRITE(FN_GEOM(N),'(A,A,I2.2,A)') TRIM(CHID),'_',N,'.ge'
   ENDDO
ENDIF
IF (GEOM_DIAG) THEN
   LU_GEOM_DIAG(1) = GET_FILE_NUMBER()
   LU_GEOM_DIAG(2) = GET_FILE_NUMBER()
   WRITE(FN_GEOM_DIAG(1),'(A,A,I2.2,A)') TRIM(CHID),'_DIAG',N,'.ge'
   WRITE(FN_GEOM_DIAG(2),'(A,A,I2.2,A)') TRIM(CHID),'_DIAG',N,'.be'
ENDIF

! TGA output

IF (TGA_SURF_INDEX>0) THEN
   LU_TGA = GET_FILE_NUMBER()
   WRITE(FN_TGA,'(A,A)') TRIM(CHID),'_tga.csv'
ENDIF

! Status File

IF (STATUS_FILES) THEN
   LU_NOTREADY = GET_FILE_NUMBER()
   FN_NOTREADY = TRIM(CHID)//'.notready'
ENDIF

IF (VELOCITY_ERROR_FILE) THEN
   LU_VELOCITY_ERROR = GET_FILE_NUMBER()
   FN_VELOCITY_ERROR = TRIM(CHID)//'_pressit.csv'
ENDIF

IF (CFL_FILE) THEN
   LU_CFL = GET_FILE_NUMBER()
   FN_CFL = TRIM(CHID)//'_cfl.csv'
ENDIF

IF (N_INIT>0) THEN
   DO N=1,N_INIT
      INITIALIZATION(N)%LU_PARTICLE = GET_FILE_NUMBER()
   ENDDO
ENDIF

END SUBROUTINE ASSIGN_FILE_NAMES


SUBROUTINE INITIALIZE_GLOBAL_DUMPS(T,DT)

! Open and initialize all files that are not tied to a particular mesh

USE COMP_FUNCTIONS, ONLY: CURRENT_TIME
USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION_ALL,GET_MOLECULAR_WEIGHT
USE CONTROL_VARIABLES
REAL(EB) :: TNOW
REAL(EB), INTENT(IN) :: T,DT
INTEGER :: NN,I,N,N_OUT,N_ZONE_TMP,LU,J
CHARACTER(80) :: FN
CHARACTER(LABEL_LENGTH) :: LAB,UNITS
CHARACTER(LABEL_LENGTH), DIMENSION(42) :: LABEL='null'
CHARACTER(LABEL_LENGTH), DIMENSION(:), ALLOCATABLE ::  P_ZONE_ID

TNOW=CURRENT_TIME()

CALL INITIALIZE_DIAGNOSTIC_FILE(DT)

! Initialize device output file (CHID_devc.csv)

IF (N_DEVC_TIME>0) THEN

   ALLOCATE(TIME_DEVC_LABEL(N_DEVC_TIME))
   ALLOCATE(TIME_DEVC_UNITS(N_DEVC_TIME))
   ALLOCATE(TIME_DEVC_VALUE(N_DEVC_TIME))

   NN = 0
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE==0 .AND. DV%OUTPUT) THEN
         NN = NN + 1
         TIME_DEVC_LABEL(NN) = DV%ID
         TIME_DEVC_UNITS(NN) = DV%UNITS
      ENDIF
   ENDDO

   DO I = 1,N_DEVC_FILES
      IF (APPEND) THEN
         OPEN(LU_DEVC(I),FILE=FN_DEVC(I),FORM='FORMATTED',STATUS='OLD')
         CALL APPEND_FILE(LU_DEVC(I),2,T_BEGIN+(T-T_BEGIN)*TIME_SHRINK_FACTOR)
      ELSE
         N_OUT = MIN(DEVC_COLUMN_LIMIT , N_DEVC_TIME-DEVC_COLUMN_LIMIT*(I-1))
         OPEN(LU_DEVC(I),FILE=FN_DEVC(I),FORM='FORMATTED',STATUS='REPLACE')
         WRITE(TCFORM,'(A,I5.5,A)') "(",N_OUT,"(A,','),A)"
         WRITE(LU_DEVC(I),TCFORM) 's',(TRIM(TIME_DEVC_UNITS(N)),N=DEVC_COLUMN_LIMIT*(I-1)+1,MIN(N_DEVC_TIME,I*DEVC_COLUMN_LIMIT))
         WRITE(TCFORM,'(A,I5.5,A)') "(A,",N_OUT,"(',',3A))"
         WRITE(LU_DEVC(I),TCFORM) 'Time',('"',TRIM(TIME_DEVC_LABEL(N)),'"', &
                                  N=DEVC_COLUMN_LIMIT * (I - 1) + 1,MIN(N_DEVC_TIME, I * DEVC_COLUMN_LIMIT))
      ENDIF
   ENDDO

ENDIF

! Define labels for histogram output

IF (N_PDPA_HISTOGRAM>0) THEN

   ALLOCATE(PDPA_HISTOGRAM_LABEL(N_PDPA_HISTOGRAM))
   ALLOCATE(PDPA_HISTOGRAM_UNITS(N_PDPA_HISTOGRAM))
   ALLOCATE(PDPA_HISTOGRAM_VALUE(N_PDPA_HISTOGRAM,MAX_PDPA_HISTOGRAM_NBINS))

   NN = 0
   DO N=1,N_DEVC
      DV => DEVICE(N)
      PY => PROPERTY(DV%PROP_INDEX)
      SELECT CASE(PY%QUANTITY)
         CASE('U-VELOCITY','V-VELOCITY','W-VELOCITY','VELOCITY')
            LAB="vel_"//TRIM(DV%ID)
            UNITS="m/s"
         CASE('TEMPERATURE')
            LAB="T_"//TRIM(DV%ID)
            UNITS="C"
         CASE('ENTHALPY')
            LAB="h_"//TRIM(DV%ID)
            UNITS="kJ"
         CASE DEFAULT
            LAB="D_"//TRIM(DV%ID)
            UNITS="mu-m"
      END SELECT
      IF (PY%PDPA_HISTOGRAM) THEN
         NN = NN+1
         IF(PY%PDPA_NORMALIZE) THEN
            PDPA_HISTOGRAM_LABEL(NN) = TRIM(LAB)//','//TRIM(DV%ID)
            PDPA_HISTOGRAM_UNITS(NN) = TRIM(UNITS)//',-'
         ELSE
            PDPA_HISTOGRAM_LABEL(NN) = TRIM(LAB)//','//TRIM(DV%ID)
            PDPA_HISTOGRAM_UNITS(NN) = TRIM(UNITS)//',#'
         ENDIF
      ENDIF
   ENDDO
ENDIF

! Define labels for line devices

IF (N_DEVC_LINE>0) THEN

   ALLOCATE(LINE_DEVC_LABEL(N_DEVC_LINE))
   ALLOCATE(LINE_DEVC_UNITS(N_DEVC_LINE))
   ALLOCATE(LINE_DEVC_VALUE(N_DEVC_LINE,MAX_DEVC_LINE_POINTS))

   NN = 0
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE>0 .AND. DV%POINT==1) THEN
         NN = NN+1
         SELECT CASE(DV%LINE_COORD_CODE)
            CASE(0)
               LINE_DEVC_LABEL(NN) = TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%UNITS)
            CASE(1)
               LINE_DEVC_LABEL(NN) = TRIM(DV%X_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(2)
               LINE_DEVC_LABEL(NN) = TRIM(DV%Y_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(3)
               LINE_DEVC_LABEL(NN) = TRIM(DV%Z_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(4)
               LINE_DEVC_LABEL(NN) = TRIM(DV%R_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(5)
               LINE_DEVC_LABEL(NN) = TRIM(DV%D_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(12)
               LINE_DEVC_LABEL(NN) = TRIM(DV%X_ID)//','//TRIM(DV%Y_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(13)
               LINE_DEVC_LABEL(NN) = TRIM(DV%X_ID)//','//TRIM(DV%Z_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(23)
               LINE_DEVC_LABEL(NN) = TRIM(DV%Y_ID)//','//TRIM(DV%Z_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
            CASE(123)
               LINE_DEVC_LABEL(NN) = TRIM(DV%X_ID)//','//TRIM(DV%Y_ID)//','//TRIM(DV%Z_ID)//','//TRIM(DV%ID)
               LINE_DEVC_UNITS(NN) = TRIM(DV%XYZ_UNITS)//','//TRIM(DV%XYZ_UNITS)//','//TRIM(DV%XYZ_UNITS)//','//TRIM(DV%UNITS)
         END SELECT
      ENDIF
   ENDDO

ENDIF

! Initialize control output file (CHID_ctrl.csv)

IF (N_CTRL>0) THEN
   DO I = 1,N_CTRL_FILES
      IF (APPEND) THEN
         OPEN(LU_CTRL(I),FILE=FN_CTRL(I),FORM='FORMATTED',STATUS='OLD')
         CALL APPEND_FILE(LU_CTRL(I),2,T_BEGIN+(T-T_BEGIN)*TIME_SHRINK_FACTOR)
      ELSE
         OPEN(LU_CTRL(I),FILE=FN_CTRL(I),FORM='FORMATTED',STATUS='REPLACE')
         N_OUT = MIN(CTRL_COLUMN_LIMIT, N_CTRL - CTRL_COLUMN_LIMIT * (I - 1))
         WRITE(TCFORM,'(A,I5.5,A)') "(",N_OUT,"(A,','),A)"
         WRITE(LU_CTRL(I),TCFORM) 's',('status',N=CTRL_COLUMN_LIMIT * (I - 1) + 1,MIN(N_CTRL, I * CTRL_COLUMN_LIMIT))
         WRITE(TCFORM,'(A,I5.5,A)') "(A,",N_OUT,"(',',3A))"
         WRITE(LU_CTRL(I),TCFORM) 'Time',('"',TRIM(CONTROL(N)%ID),'"', &
                                   N=CTRL_COLUMN_LIMIT * (I - 1) + 1,MIN(N_CTRL, I * CTRL_COLUMN_LIMIT))
      ENDIF
   ENDDO
ENDIF

! Open heat release rate file (CHID_hrr.csv)

N_ZONE_TMP = 0
IF (N_ZONE>0) THEN
   ALLOCATE(P_ZONE_ID(N_ZONE))
   DO N=1,N_ZONE
      IF (.NOT.P_ZONE(N)%EVACUATION) THEN
         N_ZONE_TMP = N_ZONE_TMP + 1
         P_ZONE_ID(N_ZONE_TMP) = P_ZONE(N)%ID
      ENDIF
   ENDDO
ENDIF

IF (APPEND) THEN
   OPEN(LU_HRR,FILE=FN_HRR,FORM='FORMATTED',STATUS='OLD')
   CALL APPEND_FILE(LU_HRR,2,T_BEGIN+(T-T_BEGIN)*TIME_SHRINK_FACTOR)
ELSE
   OPEN(LU_HRR,FILE=FN_HRR,FORM='FORMATTED',STATUS='REPLACE')
   WRITE(TCFORM,'(A,I4.4,A)') "(",11+N_ZONE_TMP,"(A,','),A)"
   WRITE(LU_HRR,TCFORM) 's','kW','kW','kW','kW','kW','kW','kW','kW','kW','kg/s','kg/s',('Pa',N=1,N_ZONE_TMP)
   IF (N_ZONE_TMP>0) THEN
      WRITE(LU_HRR,TCFORM) 'Time','HRR','Q_RADI','Q_CONV','Q_COND','Q_DIFF','Q_PRES','Q_PART','Q_ENTH','Q_TOTAL',&
                           'MLR_FUEL','MLR_TOTAL',(TRIM(P_ZONE(N)%ID),N=1,N_ZONE_TMP)
   ELSE
      WRITE(LU_HRR,TCFORM) 'Time','HRR','Q_RADI','Q_CONV','Q_COND','Q_DIFF','Q_PRES','Q_PART','Q_ENTH','Q_TOTAL',&
                           'MLR_FUEL','MLR_TOTAL'
   ENDIF
ENDIF
IF (N_ZONE>0) DEALLOCATE(P_ZONE_ID)

! Open species mass file

IF_DUMP_SPECIES_INFO: IF (MASS_FILE) THEN
   IF (APPEND) THEN
      OPEN(LU_MASS,FILE=FN_MASS,FORM='FORMATTED',STATUS='OLD')
      CALL APPEND_FILE(LU_MASS,2,T_BEGIN+(T-T_BEGIN)*TIME_SHRINK_FACTOR)
   ELSE
      OPEN(LU_MASS,FILE=FN_MASS,FORM='FORMATTED',STATUS='REPLACE')
      LABEL(1) = 'Time'
      LABEL(2) = 'Total'
      NN=2
      LABEL(3:3+N_SPECIES-1) = SPECIES(1:N_SPECIES)%ID
      WRITE(TCFORM,'(A,I4.4,A)') "(",N_SPECIES+1,"(A,','),A)"
      WRITE(LU_MASS,TCFORM) 's',('kg',N=1,N_SPECIES+1)
      WRITE(LU_MASS,TCFORM) (TRIM(LABEL(N)),N=1,N_SPECIES+2)
   ENDIF
ENDIF IF_DUMP_SPECIES_INFO

! Special output for pressure iteration scheme

IF (VELOCITY_ERROR_FILE) THEN
   OPEN(UNIT=LU_VELOCITY_ERROR,FILE=FN_VELOCITY_ERROR,FORM='FORMATTED',STATUS='UNKNOWN',POSITION='REWIND')
   WRITE(LU_VELOCITY_ERROR,'(A)') 'Time Step,Iteration,Total,Mesh,I,J,K,Velocity Error,Mesh,I,J,K,Pressure Error'
ENDIF

! Special output for detailed CFL info

IF (CFL_FILE) THEN
   OPEN(UNIT=LU_CFL,FILE=FN_CFL,FORM='FORMATTED',STATUS='UNKNOWN',POSITION='REWIND')
   WRITE(LU_CFL,'(A)') 'Cycle,t,dt,CFL,Mesh,i,j,k,u_i-1,u_i,v_j-1,v_j,w_k-1,w_k,VN,Mesh,i,j,k'
ENDIF


! Check particle sample distribution

PART_DIST_LOOP: DO I=1,N_LAGRANGIAN_CLASSES
   LPC=>LAGRANGIAN_PARTICLE_CLASS(I)
   IF (.NOT.LPC%CHECK_DISTRIBUTION .OR. LPC%MONODISPERSE .OR. LPC%DIAMETER<TWO_EPSILON_EB) CYCLE PART_DIST_LOOP
   LU = GET_FILE_NUMBER()
   WRITE(FN,'(A,A,A,A)') TRIM(CHID),'_',TRIM(LPC%ID),'_cdf.csv'
   OPEN (LU,FILE=FN,FORM='FORMATTED',STATUS='REPLACE')
   WRITE(LU,'(A)') 'd (mu-m),CNF,CVF'
   DO J=0,NDC
      WRITE(LU,'(E16.9,A,E16.9,A,E16.9)') 2.E6_EB*LPC%R_CNF(J),',',LPC%CNF(J),',',LPC%CVF(J)
   ENDDO
   CLOSE(LU)
ENDDO PART_DIST_LOOP

! IBM geometry output

BOUNDARY_ELEMENT_FILES: DO N=1,N_BNDE

   RESTART_BE: IF (APPEND) THEN
      OPEN(LU_BNDE(N),FILE=FN_BNDE(N),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
   ELSE RESTART_BE
      OPEN(LU_BNDE(N),FILE=FN_BNDE(N),FORM='UNFORMATTED',STATUS='REPLACE')
      WRITE(LU_BNDE(N)) ONE_INTEGER
      WRITE(LU_BNDE(N)) ZERO_INTEGER
   ENDIF RESTART_BE

ENDDO BOUNDARY_ELEMENT_FILES

UNSTRUCTURED_GEOMETRY: IF (N_FACE>0 .AND. N_GEOMETRY==0) THEN ! don't do anything if there are &GEOM lines
   DO N=1,1 ! loop over number of geometry groups
      RESTART_GE: IF (APPEND) THEN
         OPEN(LU_GEOM(N),FILE=FN_GEOM(N),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
      ELSE RESTART_GE
         OPEN(LU_GEOM(N),FILE=FN_GEOM(N),FORM='UNFORMATTED',STATUS='REPLACE')
         WRITE(LU_GEOM(N)) ONE_INTEGER
         WRITE(LU_GEOM(N)) ZERO_INTEGER
         WRITE(LU_GEOM(N)) ZERO_INTEGER ! floating point header
         WRITE(LU_GEOM(N)) ZERO_INTEGER ! integer header
         !WRITE(LU_GEOM(N)) ZERO_INTEGER, ZERO_INTEGER ! static vertices and faces
      ENDIF RESTART_GE
   ENDDO
ENDIF UNSTRUCTURED_GEOMETRY

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE INITIALIZE_GLOBAL_DUMPS


SUBROUTINE INITIALIZE_MESH_DUMPS(NM)

USE COMP_FUNCTIONS, ONLY : CURRENT_TIME
USE MEMORY_FUNCTIONS, ONLY:RE_ALLOCATE_STRINGS,CHKMEMERR
INTEGER, INTENT(IN) :: NM
INTEGER :: IOR,IZERO,I,J,K,N,I1B,I2B,IW,NN,NF,IP,N_BNDF_POINTS
INTEGER :: NTSL
REAL(EB) :: TNOW
CHARACTER(LEN=1024) :: SLICEPARMS, SLICELABEL, SLICEOFFSET
CHARACTER(7) :: SMLAB
TYPE(PATCH_TYPE), POINTER :: PA
INTEGER :: USE_MAX_SMV
REAL(FB) :: MAX_SMV
INTEGER, PARAMETER :: SOOT=1, FIRE=2, TEMP=3, CO2=4


TNOW=CURRENT_TIME()

M => MESHES(NM)

IBAR=>M%IBAR
JBAR=>M%JBAR
KBAR=>M%KBAR
IBP1=>M%IBP1
JBP1=>M%JBP1
KBP1=>M%KBP1

! Compute grid coords in single precision for output

ALLOCATE(M%XPLT(0:IBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','XPLT',IZERO)
ALLOCATE(M%YPLT(0:JBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','YPLT',IZERO)
ALLOCATE(M%ZPLT(0:KBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','ZPLT',IZERO)

DO I=0,IBAR
   M%XPLT(I) = REAL(M%X(I),FB)
ENDDO
DO J=0,JBAR
   M%YPLT(J) = REAL(M%Y(J),FB)
ENDDO
DO K=0,KBAR
   M%ZPLT(K) = REAL(M%Z(K),FB)
ENDDO

! Initialize PLOT3D grid file (CHID.xyz)

ALLOCATE(M%IBLK(0:IBAR,0:JBAR,0:KBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','IBLK',IZERO)
ALLOCATE(M%QQ(0:IBP1,0:JBP1,0:KBP1,5),STAT=IZERO)
CALL ChkMemErr('DUMP','QQ',IZERO)
ALLOCATE(M%QQ2(0:IBP1,0:JBP1,0:KBP1,1),STAT=IZERO)
CALL ChkMemErr('DUMP','QQ2',IZERO)
M%QQ=0._FB
M%QQ2=0._FB

WRITE_XYZ_FILE: IF (WRITE_XYZ .AND. .NOT.EVACUATION_ONLY(NM)) THEN
   OPEN(LU_XYZ(NM),FILE=FN_XYZ(NM),FORM='UNFORMATTED',STATUS='REPLACE')
   DO K=0,KBAR
      DO J=0,JBAR
         DO I=0,IBAR
            IF (M%SOLID(M%CELL_INDEX(I,J,K))    .AND. M%SOLID(M%CELL_INDEX(I+1,J,K))   .AND. &
                M%SOLID(M%CELL_INDEX(I,J+1,K))  .AND. M%SOLID(M%CELL_INDEX(I,J,K+1))   .AND. &
                M%SOLID(M%CELL_INDEX(I+1,J+1,K)).AND. M%SOLID(M%CELL_INDEX(I+1,J,K+1)) .AND. &
                M%SOLID(M%CELL_INDEX(I,J+1,K+1)).AND. M%SOLID(M%CELL_INDEX(I+1,J+1,K+1)) ) THEN
               M%IBLK(I,J,K) = 0
            ELSE
               M%IBLK(I,J,K) = 1
            ENDIF
         ENDDO
      ENDDO
   ENDDO
   WRITE(LU_XYZ(NM)) IBP1,JBP1,KBP1
   WRITE(LU_XYZ(NM)) (((M%XPLT(I),I=0,IBAR),J=0,JBAR),K=0,KBAR),(((M%YPLT(J),I=0,IBAR),J=0,JBAR),K=0,KBAR), &
                     (((M%ZPLT(K),I=0,IBAR),J=0,JBAR),K=0,KBAR),(((M%IBLK(I,J,K),I=0,IBAR),J=0,JBAR),K=0,KBAR)
   CLOSE(LU_XYZ(NM))
   IF (M%N_STRINGS+2>M%N_STRINGS_MAX) THEN
      CALL RE_ALLOCATE_STRINGS(NM)
   ENDIF
   M%N_STRINGS = M%N_STRINGS + 1
   WRITE(M%STRING(M%N_STRINGS),'(A)') 'XYZ'
   M%N_STRINGS = M%N_STRINGS + 1
   WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_XYZ(NM))
ENDIF WRITE_XYZ_FILE

! Re-allocate IBLK array for use with isosurface generation

DEALLOCATE(M%IBLK)
ALLOCATE(M%IBLK(1:IBAR,1:JBAR,1:KBAR),STAT=IZERO)
CALL ChkMemErr('DUMP','IBLK',IZERO)

! Initialize isosurface file

   DO N=1,N_ISOF
      IF (EVACUATION_ONLY(NM)) CYCLE
      IS => ISOSURFACE_FILE(N)
      IF (APPEND) THEN
        OPEN(ABS(LU_ISOF(N,NM)),FILE=FN_ISOF(N,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
        IF(IS%INDEX2 /= -1 ) THEN
           OPEN(ABS(LU_ISOF2(N,NM)),FILE=FN_ISOF2(N,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
        ENDIF
      ELSE
        OPEN(ABS(LU_ISOF(N,NM)),FILE=FN_ISOF(N,NM),FORM='UNFORMATTED',STATUS='REPLACE')
        IF (IS%INDEX2 /= -1 ) THEN
           OPEN(ABS(LU_ISOF2(N,NM)),FILE=FN_ISOF2(N,NM),FORM='UNFORMATTED',STATUS='REPLACE')
        ENDIF
        IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
        M%N_STRINGS = M%N_STRINGS + 1
        IF (IS%INDEX2 .EQ. -1 ) THEN
           WRITE(M%STRING(M%N_STRINGS),'(A,I6,1X,I6,1X,E13.6)') 'ISOG',NM,IS%SKIP,IS%DELTA
        ELSE
           WRITE(M%STRING(M%N_STRINGS),'(A,I6,1X,I6,1X,E13.6)') 'TISOG',NM,IS%SKIP,IS%DELTA
        ENDIF
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_ISOF(N,NM)) ! geometry
        IF (IS%INDEX2 /= -1 ) THEN
           M%N_STRINGS = M%N_STRINGS + 1
           WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_ISOF2(N,NM)) ! data
        ENDIF
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_LABEL) ! labels for geometry
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_BAR_LABEL)
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(IS%INDEX)%UNITS)
        IF (IS%INDEX2 /= -1 ) THEN
           M%N_STRINGS = M%N_STRINGS + 1
           WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_LABEL2) ! labels for data
           M%N_STRINGS = M%N_STRINGS + 1
           WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(IS%SMOKEVIEW_BAR_LABEL2)
           M%N_STRINGS = M%N_STRINGS + 1
           WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(IS%INDEX2)%UNITS)
        ENDIF
      ENDIF
   ENDDO

! Initialize Smoke3d file

SMOKE3D_INITIALIZATION: IF (SMOKE3D .AND. .NOT.EVACUATION_ONLY(NM)) THEN

   DO N=1,4
      IF (SMOKE3D_QUANTITY_INDEX(N)==0) CYCLE
      IF (APPEND) THEN
         OPEN(ABS(LU_SMOKE3D(N,NM)),  FILE=FN_SMOKE3D(N,NM),  FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
         OPEN(ABS(LU_SMOKE3D(N+4,NM)),FILE=FN_SMOKE3D(N+4,NM),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
      ELSE
         IF (N==SOOT .OR. N==FIRE) SMLAB = 'SMOKF3D'
         IF (N==TEMP .OR. N==CO2) SMLAB = 'SMOKG3D'
         OPEN(ABS(LU_SMOKE3D(N,NM)),  FILE=FN_SMOKE3D(N,NM),  FORM='UNFORMATTED',STATUS='REPLACE')
         OPEN(ABS(LU_SMOKE3D(N+4,NM)),FILE=FN_SMOKE3D(N+4,NM),FORM='FORMATTED',STATUS='REPLACE')
         IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
         M%N_STRINGS = M%N_STRINGS + 1
         IF (N==FIRE .AND.USE_HRRPUV_MAX_SMV==1 ) THEN
            MAX_SMV = HRRPUV_MAX_SMV
            USE_MAX_SMV = 1
         ELSE IF (N==TEMP .AND. USE_TEMP_MAX_SMV==1 ) THEN
            MAX_SMV = TEMP_MAX_SMV
            USE_MAX_SMV = 1
         ELSE
            USE_MAX_SMV = 0
         ENDIF
         IF (USE_MAX_SMV==1) THEN
            WRITE(M%STRING(M%N_STRINGS),'(A,A,I6,1X,E13.6)') 'V',TRIM(SMLAB),NM,MAX_SMV
         ELSE
            WRITE(M%STRING(M%N_STRINGS),'(A,I6)') TRIM(SMLAB),NM
         ENDIF
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SMOKE3D(N,NM))
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SMOKE3D_SMOKEVIEW_LABEL(N))
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SMOKE3D_SMOKEVIEW_BAR_LABEL(N))
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(SMOKE3D_QUANTITY_INDEX(N))%UNITS)
      ENDIF
   ENDDO

ENDIF SMOKE3D_INITIALIZATION

! Initialize Slice Files

NTSL = 0

DO N=1,M%N_SLCF
   SL => M%SLICE(N)
   IF (.NOT.APPEND) THEN

   ! write out slice file info to .sf files

      OPEN(LU_SLCF(N,NM),FILE=FN_SLCF(N,NM),FORM='UNFORMATTED',STATUS='REPLACE')
      WRITE(LU_SLCF(N,NM)) SL%SMOKEVIEW_LABEL(1:30)
      WRITE(LU_SLCF(N,NM)) SL%SMOKEVIEW_BAR_LABEL(1:30)
      WRITE(LU_SLCF(N,NM)) OUTPUT_QUANTITY(SL%INDEX)%UNITS(1:30)
      IF (.NOT.SL%TERRAIN_SLICE) THEN
         WRITE(LU_SLCF(N,NM)) SL%I1,SL%I2,SL%J1,SL%J2,SL%K1,SL%K2
         WRITE(SLICEPARMS,'(A,I6,I6,I6,I6,I6,I6)') ' &',SL%I1,SL%I2,SL%J1,SL%J2,SL%K1,SL%K2
      ELSE
         NTSL = NTSL + 1
         IF (SL%I1 == 0)    M%K_AGL_SLICE(0,SL%J1:SL%J2,NTSL)    = M%K_AGL_SLICE(1,SL%J1:SL%J2,NTSL)
         IF (SL%I2 == IBP1) M%K_AGL_SLICE(IBP1,SL%J1:SL%J2,NTSL) = M%K_AGL_SLICE(IBP1-1,SL%J1:SL%J2,NTSL)
         IF (SL%J1 == 0)    M%K_AGL_SLICE(SL%I1:SL%I2,0,NTSL)    = M%K_AGL_SLICE(SL%I1:SL%I2,1,NTSL)
         IF (SL%J2 == JBP1) M%K_AGL_SLICE(SL%I1:SL%I2,JBP1,NTSL) = M%K_AGL_SLICE(SL%I1:SL%I2,JBP1-1,NTSL)
         WRITE(LU_SLCF(N,NM)) SL%I1,SL%I2,SL%J1,SL%J2,M%K_AGL_SLICE(SL%I1,SL%J1,NTSL),M%K_AGL_SLICE(SL%I1,SL%J1,NTSL)
         WRITE(SLICEPARMS,'(A,I6,I6,I6,I6,I6,I6)') ' &',SL%I1,SL%I2,SL%J1,SL%J2,&
                            M%K_AGL_SLICE(SL%I1,SL%J1,NTSL),M%K_AGL_SLICE(SL%I1,SL%J1,NTSL)
      ENDIF

   ! write out slice file info to the .smv file

      IF (SL%SLICETYPE=='STRUCTURED') THEN
         IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      ELSE
         IF (M%N_STRINGS+8>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(A,1x,I6)') 'SGEOM',0
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SLCF_GEOM(N,NM))
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      SLICEOFFSET = ''
      IF(SL%SMV_OFFSET/=0.0_EB)WRITE(SLICEOFFSET,'(A,F10.4)')' $ ',SL%SMV_OFFSET
      IF (SL%ID/='null') THEN
         WRITE(SLICELABEL,'(A,A,A,A,A,A,A,I6)') ' # ',TRIM(SL%SLICETYPE),' %',TRIM(SL%ID),TRIM(SLICEPARMS),TRIM(SLICEOFFSET),&
                                                ' ! ',SL%SLCF_INDEX
      ELSE
         WRITE(SLICELABEL,'(A,A,A,A,A,I6)') ' # ',TRIM(SL%SLICETYPE),TRIM(SLICEPARMS),TRIM(SLICEOFFSET),&
                                            ' ! ',SL%SLCF_INDEX
      ENDIF
      IF (SL%SLICETYPE=='STRUCTURED') THEN
         IF (.NOT.SL%TERRAIN_SLICE .AND. .NOT.SL%CELL_CENTERED) THEN
            WRITE(M%STRING(M%N_STRINGS),'(A,I6,A)') 'SLCF',NM,TRIM(SLICELABEL)
         ENDIF
         IF (SL%CELL_CENTERED) THEN
            WRITE(M%STRING(M%N_STRINGS),'(A,I6,A)') 'SLCC',NM,TRIM(SLICELABEL)
         ENDIF
         IF (SL%FACE_CENTERED) THEN
            WRITE(M%STRING(M%N_STRINGS),'(A,I6,A)') 'SLCD',NM,TRIM(SLICELABEL)
         ENDIF
      ELSE
         WRITE(M%STRING(M%N_STRINGS),'(A,I6,A)') 'BNDS',NM,TRIM(SLICELABEL)
      ENDIF
      IF (SL%TERRAIN_SLICE) THEN
        IF (SL%FIRE_LINE) THEN
           WRITE(M%STRING(M%N_STRINGS),'(A,I6,F10.4,A)') 'SLFL',NM,SL%SLICE_AGL,TRIM(SLICEPARMS)
        ELSE
           WRITE(M%STRING(M%N_STRINGS),'(A,I6,F10.4,A)') 'SLCT',NM,SL%SLICE_AGL,TRIM(SLICEPARMS)
        ENDIF
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SLCF(N,NM))
      IF (SL%SLICETYPE/='STRUCTURED') THEN
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_SLCF_GEOM(N,NM))
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SL%SMOKEVIEW_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(SL%SMOKEVIEW_BAR_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(SL%INDEX)%UNITS)

      CLOSE(LU_SLCF(N,NM))
   ENDIF
ENDDO

! Initialize Boundary Files

IF_BOUNDARY_FILES: IF (N_BNDF>0 .AND. .NOT.EVACUATION_ONLY(NM)) THEN

   I1B = MAX(IBP1,JBP1)
   I2B = MAX(JBP1,KBP1)
   ALLOCATE(M%PP(0:I1B,0:I2B),STAT=IZERO)
   CALL ChkMemErr('DUMP','PP',IZERO)
   M%PP = 0._EB
   ALLOCATE(M%PPN(0:I1B,0:I2B),STAT=IZERO)
   CALL ChkMemErr('DUMP','PPN',IZERO)
   ALLOCATE(M%IBK(0:I1B,0:I2B),STAT=IZERO)
   CALL ChkMemErr('DUMP','IBK',IZERO)

   M%INC = 0
   DO IW=1,M%N_EXTERNAL_WALL_CELLS+M%N_INTERNAL_WALL_CELLS
      IOR = M%WALL(IW)%ONE_D%IOR
      IF (M%WALL(IW)%BOUNDARY_TYPE==SOLID_BOUNDARY .OR. M%WALL(IW)%BOUNDARY_TYPE==NULL_BOUNDARY) &
          M%INC(IOR,M%WALL(IW)%OBST_INDEX) = 1
      IF (.NOT.BNDF_DEFAULT .AND. M%WALL(IW)%OBST_INDEX==0) M%INC(IOR,M%WALL(IW)%OBST_INDEX) = 0
   !! IF (.NOT.BNDF_DEFAULT                               ) M%INC(IOR,M%WALL(IW)%OBST_INDEX) = 0
   ENDDO

   ! Count and allocate the boundary file PATCHes.

   M%N_PATCH = 0
   DO N=0,M%N_OBST
      OB=>M%OBSTRUCTION(N)
      DO IOR=-3,3
         IF (.NOT.OB%SHOW_BNDF(IOR)) M%INC(IOR,N) = 0
         IF (ABS(IOR)==2 .AND. TWO_D) M%INC(IOR,N) = 0
         IF (M%INC(IOR,N)==1) M%N_PATCH = M%N_PATCH + 1
      ENDDO
   ENDDO

   ALLOCATE(M%PATCH(M%N_PATCH),STAT=IZERO)
   CALL ChkMemErr('DUMP','PATCH',IZERO)

   ! Assign coordinate indices for each PATCH

   IP = 0
   N_BNDF_POINTS = 0
   DO N=0,M%N_OBST
      OB=>M%OBSTRUCTION(N)
      DO IOR=-3,3
         IF (M%INC(IOR,N)==0) CYCLE
         IP = IP + 1
         PA => M%PATCH(IP)
         IF (N==0) THEN
            PA%I1 = 0     ; PA%IG1 = 1
            PA%I2 = IBAR  ; PA%IG2 = IBAR
            PA%J1 = 0     ; PA%JG1 = 1
            PA%J2 = JBAR  ; PA%JG2 = JBAR
            PA%K1 = 0     ; PA%KG1 = 1
            PA%K2 = KBAR  ; PA%KG2 = KBAR
            SELECT CASE(IOR)
               CASE( 1) ; PA%I2 = PA%I1 ; PA%IG2 = PA%IG1
               CASE(-1) ; PA%I1 = PA%I2 ; PA%IG1 = PA%IG2
               CASE( 2) ; PA%J2 = PA%J1 ; PA%JG2 = PA%JG1
               CASE(-2) ; PA%J1 = PA%J2 ; PA%JG1 = PA%JG2
               CASE( 3) ; PA%K2 = PA%K1 ; PA%KG2 = PA%KG1
               CASE(-3) ; PA%K1 = PA%K2 ; PA%KG1 = PA%KG2
            END SELECT
         ELSE
            PA%I1 = OB%I1 ; PA%IG1 = OB%I1+1
            PA%I2 = OB%I2 ; PA%IG2 = OB%I2
            PA%J1 = OB%J1 ; PA%JG1 = OB%J1+1
            PA%J2 = OB%J2 ; PA%JG2 = OB%J2
            PA%K1 = OB%K1 ; PA%KG1 = OB%K1+1
            PA%K2 = OB%K2 ; PA%KG2 = OB%K2
            SELECT CASE(IOR)
               CASE(-1) ; PA%I2 = PA%I1 ; PA%IG1=PA%IG1-1 ; PA%IG2 = PA%IG1
               CASE( 1) ; PA%I1 = PA%I2 ; PA%IG2=PA%IG2+1 ; PA%IG1 = PA%IG2
               CASE(-2) ; PA%J2 = PA%J1 ; PA%JG1=PA%JG1-1 ; PA%JG2 = PA%JG1
               CASE( 2) ; PA%J1 = PA%J2 ; PA%JG2=PA%JG2+1 ; PA%JG1 = PA%JG2
               CASE(-3) ; PA%K2 = PA%K1 ; PA%KG1=PA%KG1-1 ; PA%KG2 = PA%KG1
               CASE( 3) ; PA%K1 = PA%K2 ; PA%KG2=PA%KG2+1 ; PA%KG1 = PA%KG2
            END SELECT
         ENDIF
         PA%IOR        = IOR
         PA%OBST_INDEX = N
         N_BNDF_POINTS = N_BNDF_POINTS + (PA%IG2-PA%IG1+1)*(PA%JG2-PA%JG1+1)*(PA%KG2-PA%KG1+1)
      ENDDO
   ENDDO

   IF (BNDF_TIME_INTEGRALS>0) THEN
      ALLOCATE(M%BNDF_TIME_INTEGRAL(N_BNDF_POINTS,BNDF_TIME_INTEGRALS),STAT=IZERO)
      CALL ChkMemErr('DUMP','BNDF_TIME_INTEGRAL',IZERO)
      M%BNDF_TIME_INTEGRAL = 0._FB
   ENDIF

ENDIF IF_BOUNDARY_FILES

BOUNDARY_FILES: DO NF=1,N_BNDF

   IF (M%N_PATCH==0) EXIT BOUNDARY_FILES
   IF (EVACUATION_ONLY(NM)) EXIT BOUNDARY_FILES

   BF => BOUNDARY_FILE(NF)

   RESTART: IF (APPEND) THEN
      OPEN(LU_BNDF(NF,NM),FILE=FN_BNDF(NF,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
      IF (TERRAIN_CASE) THEN
         OPEN(LU_BNDF_SLCF(NF,NM),FILE=FN_BNDF_SLCF(NF,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
      ENDIF
   ELSE RESTART
      IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      M%N_STRINGS = M%N_STRINGS + 1
      IF (BF%CELL_CENTERED) THEN
         WRITE(M%STRING(M%N_STRINGS),'(A,2I6)') 'BNDC',NM,1
      ELSE
         WRITE(M%STRING(M%N_STRINGS),'(A,2I6)') 'BNDF',NM,1
      ENDIF
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_BNDF(NF,NM))
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%SMOKEVIEW_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%SMOKEVIEW_BAR_LABEL)
      M%N_STRINGS = M%N_STRINGS + 1
      WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%UNITS)
      OPEN(LU_BNDF(NF,NM),FILE=FN_BNDF(NF,NM),FORM='UNFORMATTED',STATUS='REPLACE')
      WRITE(LU_BNDF(NF,NM)) BF%SMOKEVIEW_LABEL(1:30)
      WRITE(LU_BNDF(NF,NM)) BF%SMOKEVIEW_BAR_LABEL(1:30)
      WRITE(LU_BNDF(NF,NM)) BF%UNITS(1:30)
      WRITE(LU_BNDF(NF,NM)) M%N_PATCH
      DO IP=1,M%N_PATCH
         PA=>M%PATCH(IP)
         WRITE(LU_BNDF(NF,NM)) PA%I1,PA%I2,PA%J1,PA%J2,PA%K1,PA%K2,PA%IOR,PA%OBST_INDEX,NM
      ENDDO
      IF (TERRAIN_CASE) THEN
        IF (M%N_STRINGS+5>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(A,I6,1X,F7.2)') 'SLCT ',NM,0.01
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_BNDF_SLCF(NF,NM))
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%SMOKEVIEW_LABEL)
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%SMOKEVIEW_BAR_LABEL)
        M%N_STRINGS = M%N_STRINGS + 1
        WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(BF%UNITS)
        OPEN(LU_BNDF_SLCF(NF,NM),FILE=FN_BNDF_SLCF(NF,NM),FORM='UNFORMATTED',STATUS='REPLACE')
        WRITE(LU_BNDF_SLCF(NF,NM)) BF%SMOKEVIEW_LABEL(1:30)
        WRITE(LU_BNDF_SLCF(NF,NM)) BF%SMOKEVIEW_BAR_LABEL(1:30)
        WRITE(LU_BNDF_SLCF(NF,NM)) BF%UNITS(1:30)
        WRITE(LU_BNDF_SLCF(NF,NM)) 0,M%IBAR,0,M%JBAR,0,0
      ENDIF
   ENDIF RESTART

ENDDO BOUNDARY_FILES

! Initialize particle dump file

PARTICLE_IF: IF ( (PARTICLE_FILE .AND. .NOT.EVACUATION_ONLY(NM)) .OR. (EVACUATION_SKIP(NM)) ) THEN

   APPEND_PARTICLE_FILE: IF (APPEND) THEN

      OPEN(LU_PART(NM),FILE=FN_PART(NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')

   ELSE APPEND_PARTICLE_FILE

      IF (M%N_STRINGS+10*N_LAGRANGIAN_CLASSES>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      N = M%N_STRINGS_MAX/MAX(1,N_LAGRANGIAN_CLASSES)
      IF (N_EVAC>0 .AND. M%N_STRINGS+10*N_EVAC>M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM)
      EVAC_ONLY: IF (EVACUATION_ONLY(NM)) THEN
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(A,I6,F10.4)') 'EVA5',NM,EVACUATION_Z_OFFSET(NM)
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_PART(NM))
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(I3)') N_EVAC
         DO N=1,N_EVAC
            M%N_STRINGS = M%N_STRINGS + 1
            WRITE(M%STRING(M%N_STRINGS),'(I3)') N
         ENDDO
      ELSE
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(A,I6)') 'PRT5',NM
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(1X,A)') TRIM(FN_PART(NM))
         M%N_STRINGS = M%N_STRINGS + 1
         WRITE(M%STRING(M%N_STRINGS),'(I7)') N_LAGRANGIAN_CLASSES

         DO N=1,N_LAGRANGIAN_CLASSES
            IF (M%N_STRINGS + 1 > M%N_STRINGS_MAX) CALL RE_ALLOCATE_STRINGS(NM) !reallocate if # PART lines requires it
            M%N_STRINGS = M%N_STRINGS + 1
            WRITE(M%STRING(M%N_STRINGS),'(I7)') N
         ENDDO
      ENDIF EVAC_ONLY

      OPEN(LU_PART(NM),FILE=FN_PART(NM),FORM='UNFORMATTED',STATUS='REPLACE')
      WRITE(LU_PART(NM)) ONE_INTEGER                ! The number ONE, to indicate file Endian-ness
      WRITE(LU_PART(NM)) NINT(VERSION_NUMBER*100.)  ! FDS version number
      EVAC_ONLY2: IF (EVACUATION_ONLY(NM)) THEN
         WRITE(LU_PART(NM)) N_EVAC
         DO N=1,N_EVAC
            WRITE(LU_PART(NM)) EVAC_N_QUANTITIES,ZERO_INTEGER  ! ZERO_INTEGER is a place holder for future INTEGER quantities
            DO NN=1,EVAC_N_QUANTITIES
               WRITE(LU_PART(NM)) OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%NAME(1:30)
               WRITE(LU_PART(NM)) OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%UNITS(1:30)
            ENDDO
         ENDDO
      ELSE
         WRITE(LU_PART(NM)) N_LAGRANGIAN_CLASSES
         DO N=1,N_LAGRANGIAN_CLASSES
            LPC => LAGRANGIAN_PARTICLE_CLASS(N)
            WRITE(LU_PART(NM)) LPC%N_QUANTITIES,ZERO_INTEGER  ! ZERO_INTEGER is a place holder for future INTEGER quantities
            DO NN=1,LPC%N_QUANTITIES
               WRITE(LU_PART(NM)) LPC%SMOKEVIEW_LABEL(NN)(1:30)
               WRITE(LU_PART(NM)) OUTPUT_QUANTITY(LPC%QUANTITIES_INDEX(NN))%UNITS(1:30)
            ENDDO
         ENDDO
      ENDIF EVAC_ONLY2

   ENDIF APPEND_PARTICLE_FILE
ENDIF PARTICLE_IF

! Initialize PROFile data files (CHID_prof_nn.csv)

PROF_LOOP: DO N=1,N_PROF
   IF (PROFILE(N)%MESH /= NM) CYCLE PROF_LOOP
   IF (APPEND .AND. PROFILE(N)%FORMAT_INDEX==1) THEN
      OPEN(LU_PROF(N),FILE=FN_PROF(N),FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
   ELSE
      OPEN(LU_PROF(N),FILE=FN_PROF(N),FORM='FORMATTED',STATUS='REPLACE')
      IF (PROFILE(N)%FORMAT_INDEX==1) THEN
         WRITE(LU_PROF(N),'(A)') PROFILE(N)%ID
         WRITE(LU_PROF(N),'(A)') "Time(s), Npoints, Npoints x Depth (m), Npoints x Value"
         WRITE(LU_PROF(N),*)
      ENDIF
   ENDIF
ENDDO PROF_LOOP

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE INITIALIZE_MESH_DUMPS


SUBROUTINE WRITE_SMOKEVIEW_FILE

USE MATH_FUNCTIONS, ONLY: EVALUATE_RAMP,CROSS_PRODUCT
USE MEMORY_FUNCTIONS, ONLY : CHKMEMERR
USE COMP_FUNCTIONS, ONLY: SHUTDOWN
USE GEOMETRY_FUNCTIONS, ONLY: INTERIOR
USE EVAC, ONLY: N_DOORS, N_EXITS, N_ENTRYS, N_SSTANDS, EVAC_DOORS, EVAC_EXITS, EVAC_ENTRYS, EVAC_SSTANDS, &
     EVAC_EXIT_TYPE, EVAC_DOOR_TYPE, EVAC_ENTR_TYPE, EVAC_SSTAND_TYPE, NPC_EVAC, N_HOLES, &
     EVACUATION_TYPE, EVAC_HOLE_TYPE, EVAC_EVACS, EVAC_HOLES
INTEGER :: N,NN,I,J,K,NM,NX,NY,NZ,NIN,NXL,NYL,NZL,NDV,NDVDIM,COLOR_INDEX,IZERO,EVAC_CODE,STATE_INDEX,SURF_INDEX,&
           TYPE_INDEX,HI1,HI2,VI1,VI2,FACE_INDEX,VRGB(3),N_CVENT
INTEGER, ALLOCATABLE, DIMENSION(:) :: IDV1,IDV2,JDV1,JDV2,KDV1,KDV2,DUMMY_VENT_INDEX
INTEGER, ALLOCATABLE, DIMENSION(:,:,:) :: VENT_INDICES
REAL(EB) :: X1,Y1,Z1,X2,Y2,Z2,XX,YY,ZZ,PERT1(4),PERT2(4),XMIN,YMIN,ZMIN,XA,YA,ZA
TYPE SEGMENT_TYPE
REAL(EB) :: X1,X2,Y1,Y2,Z1,Z2
END TYPE SEGMENT_TYPE
TYPE (SEGMENT_TYPE), ALLOCATABLE, TARGET, DIMENSION(:) :: SEGMENT
TYPE (SEGMENT_TYPE), POINTER :: SEG=>NULL()
INTEGER :: N_SEGMENTS_MAX
TYPE (MESH_TYPE), POINTER :: MX=>NULL(),MY=>NULL(),MZ=>NULL()
TYPE (TRAN_TYPE), POINTER :: T=>NULL()
REAL(EB), ALLOCATABLE, DIMENSION(:) :: XLEVEL,YLEVEL,ZLEVEL
CHARACTER(80) PROCESS_FN_SMV
LOGICAL :: EX, FOUND_GEOM
CHARACTER(MESSAGE_LENGTH) :: MESSAGE
CHARACTER(33) :: TEMPCHAR
INTEGER :: TYPE_INDICATOR
TYPE(GEOMETRY_TYPE), POINTER :: G=>NULL()
INTEGER :: IG

! If this is a RESTART case but an old .smv file does not exist, shutdown with an ERROR.

INQUIRE(FILE=FN_SMV,EXIST=EX)
IF (.NOT.EX .AND. APPEND) THEN
   WRITE(MESSAGE,'(A,A,A)') "ERROR: The file, ",TRIM(FN_SMV),", does not exist. Set RESTART=.FALSE."
   CALL SHUTDOWN(MESSAGE) ; RETURN
ENDIF

! If this is a RESTART case, there is no need to open the .smv file except for Process 0.

IF (MYID>0 .AND. APPEND) RETURN

! In cases where the MPI processes write to their own .smv file, give each .smv file for the MPI processes 
! greater than 0 a unique name.

IF (MYID>0 .AND.      SHARED_FILE_SYSTEM) OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')

IF (MYID>0 .AND. .NOT.SHARED_FILE_SYSTEM) THEN
   WRITE(PROCESS_FN_SMV,'(A,A,I6.6,A)') TRIM(CHID),'_',MYID,'.smv'
   OPEN(LU_SMV,FILE=PROCESS_FN_SMV,FORM='FORMATTED', STATUS='REPLACE')
ENDIF

! Do the following printouts only for MPI Process 0.

MASTER_NODE_IF: IF (MYID==0) THEN

IF (SETUP_ONLY) CALL WRITE_GEOM_ALL ! write out all geometry frames if this only a setup run

! initialize the slice info file

OPEN(UNIT=LU_INFO,FILE=TRIM(CHID)//'.sinfo',FORM='FORMATTED',STATUS='REPLACE')
WRITE(LU_INFO,'(A)') ' '
CLOSE(LU_INFO)

! initialize the boundary info file

OPEN(UNIT=LU_INFO,FILE=TRIM(CHID)//'.binfo',FORM='FORMATTED',STATUS='REPLACE')
WRITE(LU_INFO,'(A)') ' '
CLOSE(LU_INFO)

! Open up the Smokeview ".smv" file

IF (APPEND) THEN
   OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED', STATUS='OLD',POSITION='APPEND')
   RETURN
ENDIF

OPEN(LU_SMV,FILE=FN_SMV,FORM='FORMATTED',STATUS='REPLACE')

! Write out TITLE

WRITE(LU_SMV,'(A)') 'TITLE'
WRITE(LU_SMV,'(1X,A)')  TRIM(TITLE)

! Indentify as terrain case

IF (TERRAIN_CASE .OR. VEG_LEVEL_SET) THEN
  WRITE(LU_SMV,'(/A)') 'AUTOTERRAIN'
  WRITE(LU_SMV,'(I3)') 1
  WRITE(LU_SMV,'(A)') TRIM(TERRAIN_IMAGE)
ENDIF

! Record the version and endian-ness in .smv file

WRITE(LU_SMV,'(/A)') 'FDSVERSION'
WRITE(LU_SMV,'(A)') TRIM(GITHASH_PP)

! Write out the GIT number and revision date to a file

OPEN(LU_GIT,FILE=FN_GIT,FORM='FORMATTED',STATUS='REPLACE')
WRITE(LU_GIT,'(A)') TRIM(GITHASH_PP)
CLOSE(LU_GIT)

! Indicate the "endian-ness" of the output files

OPEN(LU_END,FILE=FN_END,FORM='UNFORMATTED',STATUS='REPLACE')
WRITE(LU_END) ONE_INTEGER
CLOSE(LU_END)

WRITE(LU_SMV,'(/A)') 'ENDF'
WRITE(LU_SMV,'(1X,A)') TRIM(CHID)//'.end'

! Write out the name of the input file

WRITE(LU_SMV,'(/A)') 'INPF'
WRITE(LU_SMV,'(1X,A)') TRIM(FN_INPUT)

! Write out git revision number

WRITE(LU_SMV,'(/A)') 'REVISION'
WRITE(LU_SMV,'(A)') REVISION

! Write out the CHID

WRITE(LU_SMV,'(/A)') 'CHID'
WRITE(LU_SMV,'(1X,A)') TRIM(CHID)

! Write out SOLID_HT3D

WRITE(LU_SMV,'(/A)') 'SOLID_HT3D'
IF (SOLID_HT3D) THEN
   WRITE(LU_SMV,'(1X,I2)') 1
ELSE
   WRITE(LU_SMV,'(1X,I2)') 0
ENDIF

! Write out the names of the spreadsheet files

WRITE(LU_SMV,'(/A)') 'CSVF'
WRITE(LU_SMV,'(1X,A)') 'hrr'
WRITE(LU_SMV,'(1X,A)') TRIM(FN_HRR)

DO I=1,N_DEVC_FILES
   WRITE(LU_SMV,'(/A)') 'CSVF'
   WRITE(LU_SMV,'(1X,A)') 'devc'
   WRITE(LU_SMV,'(1X,A)') TRIM(FN_DEVC(I))
ENDDO

DO I=1,N_CTRL_FILES
   WRITE(LU_SMV,'(/A)') 'CSVF'
   WRITE(LU_SMV,'(1X,A)') 'ctrl'
   WRITE(LU_SMV,'(1X,A)') TRIM(FN_CTRL(I))
ENDDO

IF (MASS_FILE) THEN
   WRITE(LU_SMV,'(/A)') 'CSVF'
   WRITE(LU_SMV,'(1X,A)') 'mass'
   WRITE(LU_SMV,'(1X,A)') TRIM(FN_MASS)
ENDIF

! Write out file names specified using CSVF

DO N = 1, N_CSVF
  WRITE(LU_SMV,'(/A)') 'CSVF'
  WRITE(LU_SMV,'(1X,A)') 'ext'
  WRITE(LU_SMV,'(1X,A)') TRIM(CSVFINFO(N)%CSVFILE)
END DO

! Number of meshes

WRITE(LU_SMV,'(/A)') 'NMESHES'
WRITE(LU_SMV,'(I3)') NMESHES

! Information used for touring in Smokeview

WRITE(LU_SMV,'(/A)') 'VIEWTIMES'
WRITE(LU_SMV,'(2F10.2,I6)') 0.0_EB,MAX(0.01_EB,T_END),MAX(2,NFRAMES)

! Auxilliary CAD geometry via dxf2fds

IF (RENDER_FILE/='null') THEN
   WRITE(LU_SMV,'(/A)') 'CADGEOM'
   WRITE(LU_SMV,'(1X,A)') TRIM(RENDER_FILE)
ENDIF

! Write out smoke albedo

WRITE(LU_SMV,'(/A)') 'ALBEDO'
WRITE(LU_SMV,'(F13.5)') SMOKE_ALBEDO

! Write out smokeview IBLANK parameter

WRITE(LU_SMV,'(/A)') 'IBLANK'
IF (IBLANK_SMV) THEN
   WRITE(LU_SMV,'(1X,I1)') 1
ELSE
   WRITE(LU_SMV,'(1X,I1)') 0
ENDIF

! Write out GVEC

WRITE(LU_SMV,'(/A)') 'GVEC'
WRITE(LU_SMV,'(3F13.5)') GVEC(1),GVEC(2),GVEC(3)

! Write out info about surfaces

WRITE(LU_SMV,'(/A)') 'SURFDEF'
WRITE(LU_SMV,'(1X,A)') SURFACE(DEFAULT_SURF_INDEX)%ID

DO N=0,N_SURF
   SF => SURFACE(N)
   WRITE(LU_SMV,'(/A)') 'SURFACE'
   WRITE(LU_SMV,'(1X,A)') SURFACE(N)%ID
   IF (SF%THERMALLY_THICK) THEN
      ML => MATERIAL(SF%LAYER_MATL_INDEX(1,1))
      WRITE(LU_SMV,'(2F8.2)') TMPM,ML%EMISSIVITY
   ELSE
      WRITE(LU_SMV,'(2F8.2)') 5000.,1.0
   ENDIF
   WRITE(LU_SMV,'(I2,6F13.5)') SF%SURF_TYPE,SF%TEXTURE_WIDTH,SF%TEXTURE_HEIGHT,REAL(SF%RGB,FB)/255._FB,SF%TRANSPARENCY
   WRITE(LU_SMV,'(1X,A)') SF%TEXTURE_MAP
ENDDO

! Write out MATL info

IF (N_MATL>0) THEN
   DO N=1,N_MATL
      WRITE(LU_SMV,'(/A)') 'MATERIAL'
      WRITE(LU_SMV,'(1X,A)') MATERIAL(N)%ID
      WRITE(LU_SMV,'(1X,3F13.5)') REAL(MATERIAL(N)%RGB,FB)/255.0_FB
   ENDDO
ENDIF

! Write out immersed file info

IF (N_GEOMETRY>0) THEN
   WRITE(LU_SMV,'(/A,1X,I6)') 'GEOM',N_GEOMETRY
   WRITE(LU_SMV,'(1X,A)') FN_GEOM(1)
   DO I = 1, N_GEOMETRY
      G=>GEOMETRY(I)
      IF (TRIM(G%SURF_ID(1))=='null') THEN
         WRITE(LU_SMV,'(1X,A,1X,3(E13.6,1X))') TRIM(G%TEXTURE_MAPPING), G%TEXTURE_ORIGIN
      ELSE
         WRITE(LU_SMV,'(1X,A,1X,3(E13.6,1X),A,1X,A)') TRIM(G%TEXTURE_MAPPING), G%TEXTURE_ORIGIN,'%',TRIM(G%SURF_ID(1))
      ENDIF
   END DO
ENDIF

! Write out info about geometry diagnostic file

IF (GEOM_DIAG) THEN
   WRITE(LU_SMV,'(/A)') 'GEOMDIAG'
   WRITE(LU_SMV,'(1X,A)') FN_GEOM_DIAG(1)
   WRITE(LU_SMV,'(1X,A)') FN_GEOM_DIAG(2)
ENDIF

! Write out info about particle types

EVAC_ONLY3: IF (.NOT.ALL(EVACUATION_ONLY)) THEN
   DO N=1,N_LAGRANGIAN_CLASSES
      LPC => LAGRANGIAN_PARTICLE_CLASS(N)
      WRITE(LU_SMV,'(/A)') 'CLASS_OF_PARTICLES'
      IF (LPC%PROP_ID=='null') THEN
         WRITE(LU_SMV,'(1X,A)')     LPC%ID
      ELSE
         WRITE(LU_SMV,'(1X,A,A,A)') LPC%ID,' % % ',TRIM(LPC%PROP_ID)
      ENDIF
      WRITE(LU_SMV,'(3F13.5)') REAL(LPC%RGB,FB)/255._FB
      WRITE(LU_SMV,'(I3)') LPC%N_QUANTITIES
      DO NN=1,LPC%N_QUANTITIES
         WRITE(LU_SMV,'(1X,A)') LPC%SMOKEVIEW_LABEL(NN)
         WRITE(LU_SMV,'(1X,A)') LPC%SMOKEVIEW_BAR_LABEL(NN)
         WRITE(LU_SMV,'(1X,A)') OUTPUT_QUANTITY(LPC%QUANTITIES_INDEX(NN))%UNITS
      ENDDO
   ENDDO
ENDIF EVAC_ONLY3

! Write out info about human types for evacuation

EVAC_ONLY4: IF (ANY(EVACUATION_ONLY)) THEN
   WRITE(LU_SMV,'(/A)') 'CLASS_OF_HUMANS'
   WRITE(LU_SMV,'(1X,A,A,A)') TRIM(EVAC_CLASS_NAME(1)),' % % ',TRIM(EVAC_CLASS_NAME(1)) // '_props'
   WRITE(LU_SMV,'(3F13.5)') REAL(EVAC_CLASS_RGB(:,1),FB)/255._EB
   WRITE(LU_SMV,'(I3)') EVAC_N_QUANTITIES
   DO NN=1,EVAC_N_QUANTITIES
      WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%NAME)
      WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%SHORT_NAME)
      WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%UNITS)
   ENDDO
   DO N=2,N_EVAC
      WRITE(LU_SMV,'(/A)') 'CLASS_OF_HUMANS'
      WRITE(LU_SMV,'(1X,A,A,A)') TRIM(EVAC_CLASS_NAME(N)),' % % ',TRIM(EVAC_CLASS_PROP(N))
      WRITE(LU_SMV,'(3F13.5)') REAL(EVAC_CLASS_RGB(:,N),FB)/255._EB
      WRITE(LU_SMV,'(I3)') EVAC_N_QUANTITIES
      DO NN=1,EVAC_N_QUANTITIES
         WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%NAME)
         WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%SHORT_NAME)
         WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%UNITS)
      ENDDO
   ENDDO
   EVAC_DO1: DO NN=1,EVAC_N_QUANTITIES
      IF (OUTPUT_QUANTITY(EVAC_QUANTITIES_INDEX(NN))%NAME=='HUMAN_COLOR') THEN
         WRITE(LU_SMV,'(/A)') 'AVATAR_COLOR'
         WRITE(LU_SMV,'(I4)') EVAC_AVATAR_NCOLOR
         DO N=1,EVAC_AVATAR_NCOLOR
            WRITE(LU_SMV,'(3I4)') (EVAC_AVATAR_RGB(I,N),I=1,3)
         ENDDO
         EXIT EVAC_DO1
      ENDIF
   ENDDO EVAC_DO1

ENDIF EVAC_ONLY4


! Figure out the outline for multiblock cases

PERT1(1) = 0.0001_EB
PERT2(1) = 0.0001_EB
PERT1(2) = -.0001_EB
PERT2(2) = 0.0001_EB
PERT1(3) = -.0001_EB
PERT2(3) = -.0001_EB
PERT1(4) = 0.0001_EB
PERT2(4) = -.0001_EB

ALLOCATE(XLEVEL(0:2*NMESHES))
XLEVEL = -100000._EB
ALLOCATE(YLEVEL(0:2*NMESHES))
YLEVEL = -100000._EB
ALLOCATE(ZLEVEL(0:2*NMESHES))
ZLEVEL = -100000._EB

NXL = 0
NYL = 0
NZL = 0
DO NM=1,2*NMESHES
   XMIN = 100000._EB
   YMIN = 100000._EB
   ZMIN = 100000._EB
   DO N=1,2*NMESHES
      M => MESHES(INT((N+1)/2))
      IF (MOD(N,2)/=0) XX = M%XS
      IF (MOD(N,2)==0) XX = M%XF
      IF (MOD(N,2)/=0) YY = M%YS
      IF (MOD(N,2)==0) YY = M%YF
      IF (MOD(N,2)/=0) ZZ = M%ZS
      IF (MOD(N,2)==0) ZZ = M%ZF
      IF (XX>XLEVEL(NXL)) XMIN = MIN(XX,XMIN)
      IF (YY>YLEVEL(NYL)) YMIN = MIN(YY,YMIN)
      IF (ZZ>ZLEVEL(NZL)) ZMIN = MIN(ZZ,ZMIN)
   ENDDO
   IF (XMIN>XLEVEL(NXL)) THEN
      NXL = NXL + 1
      XLEVEL(NXL) = XMIN
   ENDIF
   IF (YMIN>YLEVEL(NYL)) THEN
      NYL = NYL + 1
      YLEVEL(NYL) = YMIN
   ENDIF
   IF (ZMIN>ZLEVEL(NZL)) THEN
      NZL = NZL + 1
      ZLEVEL(NZL) = ZMIN
   ENDIF
ENDDO

N_SEGMENTS_MAX = 100
ALLOCATE(SEGMENT(1:N_SEGMENTS_MAX),STAT=IZERO)
CALL ChkMemErr('DUMP','SEGMENT',IZERO)

N = 0

XLOOP1: DO NX=1,2*NMESHES
   MX => MESHES(INT((NX+1)/2))
   IF (MOD(NX,2)/=0) XX = MX%XS
   IF (MOD(NX,2)==0) XX = MX%XF
   YLOOP1: DO NY=1,2*NMESHES
      MY => MESHES(INT((NY+1)/2))
      IF (MOD(NY,2)/=0) YY = MY%YS
      IF (MOD(NY,2)==0) YY = MY%YF
      IF ((XX<MY%XS .OR. XX>MY%XF) .OR. (YY<MX%YS .OR. YY>MX%YF)) CYCLE YLOOP1
      Z1 = MAX(MX%ZS,MY%ZS)
      Z2 = MIN(MX%ZF,MY%ZF)
      IF (Z1>=Z2) CYCLE YLOOP1
      ZLOOP1: DO NZ=1,NZL
         ZZ = ZLEVEL(NZ)
         IF (ZZ<=Z1) CYCLE ZLOOP1
         IF (ZZ>Z2) CYCLE YLOOP1
         ZA = (Z1+ZZ)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XX+PERT1(I),YY+PERT2(I),ZA)) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            Z1 = ZZ
            CYCLE ZLOOP1
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (ABS(XX-SEG%X1)<=SPACING(SEG%X1) .AND. ABS(XX-SEG%X2)<=SPACING(SEG%X2) .AND. &
                ABS(YY-SEG%Y1)<=SPACING(SEG%Y1) .AND. ABS(YY-SEG%Y2)<=SPACING(SEG%Y2) .AND. &
                ABS(Z1-SEG%Z1)<=SPACING(SEG%Z1) .AND. ABS(ZZ-SEG%Z2)<=SPACING(SEG%Z2)) THEN
               Z1 = ZZ
               CYCLE ZLOOP1
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = XX
         SEG%X2 = XX
         SEG%Y1 = YY
         SEG%Y2 = YY
         SEG%Z1 = Z1
         SEG%Z2 = ZZ
         Z1 = ZZ
      ENDDO ZLOOP1
   ENDDO YLOOP1
ENDDO XLOOP1

XLOOP2: DO NX=1,2*NMESHES
   MX => MESHES(INT((NX+1)/2))
   IF (MOD(NX,2)/=0) XX = MX%XS
   IF (MOD(NX,2)==0) XX = MX%XF
   ZLOOP2: DO NZ=1,2*NMESHES
      MZ => MESHES(INT((NZ+1)/2))
      IF (MOD(NZ,2)/=0) ZZ = MZ%ZS
      IF (MOD(NZ,2)==0) ZZ = MZ%ZF
      IF ((XX<MZ%XS .OR. XX>MZ%XF) .OR. (ZZ<MX%ZS .OR. ZZ>MX%ZF)) CYCLE ZLOOP2
      Y1 = MAX(MX%YS,MZ%YS)
      Y2 = MIN(MX%YF,MZ%YF)
      IF (Y1>=Y2) CYCLE ZLOOP2
      YLOOP2: DO NY=1,NYL
         YY = YLEVEL(NY)
         IF (YY<=Y1) CYCLE YLOOP2
         IF (YY>Y2) CYCLE ZLOOP2
         YA = (Y1+YY)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XX+PERT1(I),YA,ZZ+PERT2(I))) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            Y1 = YY
            CYCLE YLOOP2
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (ABS(XX-SEG%X1)<=SPACING(SEG%X1) .AND. ABS(XX-SEG%X2)<=SPACING(SEG%X2) .AND. &
                ABS(Y1-SEG%Y1)<=SPACING(SEG%Y1) .AND. ABS(YY-SEG%Y2)<=SPACING(SEG%Y2) .AND. &
                ABS(ZZ-SEG%Z1)<=SPACING(SEG%Z1) .AND. ABS(ZZ-SEG%Z2)<=SPACING(SEG%Z2)) THEN
               Y1 = YY
               CYCLE YLOOP2
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = XX
         SEG%X2 = XX
         SEG%Y1 = Y1
         SEG%Y2 = YY
         SEG%Z1 = ZZ
         SEG%Z2 = ZZ
         Y1 = YY
      ENDDO YLOOP2
   ENDDO ZLOOP2
ENDDO XLOOP2

ZLOOP3: DO NZ=1,2*NMESHES
   MZ => MESHES(INT((NZ+1)/2))
   IF (MOD(NZ,2)/=0) ZZ = MZ%ZS
   IF (MOD(NZ,2)==0) ZZ = MZ%ZF
   YLOOP3: DO NY=1,2*NMESHES
      MY => MESHES(INT((NY+1)/2))
      IF (MOD(NY,2)/=0) YY = MY%YS
      IF (MOD(NY,2)==0) YY = MY%YF
      IF ((ZZ<MY%ZS .OR. ZZ>MY%ZF) .OR. (YY<MZ%YS .OR. YY>MZ%YF)) CYCLE YLOOP3
      X1 = MAX(MZ%XS,MY%XS)
      X2 = MIN(MZ%XF,MY%XF)
      IF (X1>=X2) CYCLE YLOOP3
      XLOOP3: DO NX=1,NXL
         XX = XLEVEL(NX)
         IF (XX<=X1) CYCLE XLOOP3
         IF (XX>X2) CYCLE YLOOP3
         XA = (X1+XX)/2._EB
         NIN = 0
         DO I=1,4
            IF (INTERIOR(XA,YY+PERT1(I),ZZ+PERT2(I))) NIN = NIN+1
         ENDDO
         IF (NIN/=1 .AND. NIN/=3) THEN
            X1 = XX
            CYCLE XLOOP3
            ENDIF
         DO I=1,N
            SEG=>SEGMENT(I)
            IF (ABS(X1-SEG%X1)<=SPACING(SEG%X1) .AND. ABS(XX-SEG%X2)<=SPACING(SEG%X2) .AND. &
                ABS(YY-SEG%Y1)<=SPACING(SEG%Y1) .AND. ABS(YY-SEG%Y2)<=SPACING(SEG%Y2) .AND. &
                ABS(ZZ-SEG%Z1)<=SPACING(SEG%Z1) .AND. ABS(ZZ-SEG%Z2)<=SPACING(SEG%Z2)) THEN
               X1 = XX
               CYCLE XLOOP3
            ENDIF
         ENDDO
         IF (N+1>N_SEGMENTS_MAX) CALL RE_ALLOCATE_SEGMENTS
         N = N+1
         SEG=>SEGMENT(N)
         SEG%X1 = X1
         SEG%X2 = XX
         SEG%Y1 = YY
         SEG%Y2 = YY
         SEG%Z1 = ZZ
         SEG%Z2 = ZZ
         X1 = XX
      ENDDO XLOOP3
   ENDDO YLOOP3
ENDDO ZLOOP3

WRITE(LU_SMV,'(/A)') 'OUTLINE'
WRITE(LU_SMV,'(I4)') N
DO I=1,N
   SEG=>SEGMENT(I)
   WRITE(LU_SMV,'(6F14.4)') SEG%X1,SEG%Y1,SEG%Z1,SEG%X2,SEG%Y2,SEG%Z2
ENDDO

DEALLOCATE(SEGMENT)

! Spatial offset for texture maps

WRITE(LU_SMV,'(/A)') 'TOFFSET'
WRITE(LU_SMV,'(3F13.5)') (TEX_ORI(I),I=1,3)

! Write out threshold value for HRRPUV

WRITE(LU_SMV,'(/A)') 'HRRPUVCUT'
WRITE(LU_SMV,'(I6)') ONE_INTEGER
WRITE(LU_SMV,'(F13.5)') HRRPUV_CUT/1000._EB

! Write out RAMP info to .smv file

WRITE(LU_SMV,'(/A)') 'RAMP'
WRITE(LU_SMV,'(I5)') N_RAMP
DO N=1,N_RAMP
   WRITE(LU_SMV,'(1X,A,A)')  'RAMP: ',RAMP_ID(N)
   WRITE(LU_SMV,'(I5)') RAMPS(N)%NUMBER_DATA_POINTS
   DO I=1,RAMPS(N)%NUMBER_DATA_POINTS
      WRITE(LU_SMV,'(6G12.5)') RAMPS(N)%INDEPENDENT_DATA(I),RAMPS(N)%DEPENDENT_DATA(I)
   ENDDO
ENDDO

! Write out PROPerty info to .smv file

DO N=0,N_PROP
   PY => PROPERTY(N)
   WRITE(LU_SMV,'(/A)') 'PROP'
   WRITE(LU_SMV,'(1X,A)') TRIM(PY%ID)
   WRITE(LU_SMV,'(I3)') PY%N_SMOKEVIEW_IDS
   DO NN=1,PY%N_SMOKEVIEW_IDS
      WRITE(LU_SMV,'(1X,A)') TRIM(PY%SMOKEVIEW_ID(NN))
   ENDDO
   WRITE(LU_SMV,'(I3)') PY%N_SMOKEVIEW_PARAMETERS
   DO NN=1,PY%N_SMOKEVIEW_PARAMETERS
      WRITE(LU_SMV,'(1X,A)') PY%SMOKEVIEW_PARAMETERS(NN)
   ENDDO
ENDDO

EVAC_ONLY_PROPS: IF (ANY(EVACUATION_ONLY)) THEN
   DO N=1,N_EVAC
      WRITE(LU_SMV,'(/A)') 'PROP'
      WRITE(LU_SMV,'(1X,A)') TRIM(EVAC_CLASS_NAME(N)) // '_props'
      WRITE(LU_SMV,'(I3)') 4
      WRITE(LU_SMV,'(1X,A)') TRIM('human_fixed')
      WRITE(LU_SMV,'(1X,A)') TRIM('human_altered_with_data')
      WRITE(LU_SMV,'(1X,A)') TRIM('ellipsoid')
      WRITE(LU_SMV,'(1X,A)') TRIM('disk')
      WRITE(LU_SMV,'(I3)') 1
      DO NN=1,1
         WRITE(LU_SMV,'(1X,A)') 'D=0.2'
      ENDDO
   END DO
END IF EVAC_ONLY_PROPS

! Write out DEVICE info to .smv file

DO N=1,N_DEVC
   DV => DEVICE(N)
   PY => PROPERTY(DV%PROP_INDEX)
   WRITE(LU_SMV,'(/A)') 'DEVICE'
   WRITE(LU_SMV,'(1X,A,1X,A,1X,A)') TRIM(DV%ID),'%',TRIM(DV%QUANTITY)
   STATE_INDEX = 0
   IF (DV%INITIAL_STATE) STATE_INDEX = 1
   IF (DV%X1>-900000.0) THEN
      WRITE(LU_SMV,'(6F12.5,2I3,A,6F12.5,A,A)') DV%X,DV%Y,DV%Z,ORIENTATION_VECTOR(1,DV%ORIENTATION_INDEX),&
            ORIENTATION_VECTOR(2,DV%ORIENTATION_INDEX),ORIENTATION_VECTOR(3,DV%ORIENTATION_INDEX),STATE_INDEX,0,&
            ' # ',DV%X1,DV%Y1,DV%Z1,DV%X2,DV%Y2,DV%Z2,&
            ' % ',TRIM(PY%ID)
   ELSE
      WRITE(LU_SMV,'(6F12.5,2I3,A,A)') DV%X,DV%Y,DV%Z,ORIENTATION_VECTOR(1,DV%ORIENTATION_INDEX),&
            ORIENTATION_VECTOR(2,DV%ORIENTATION_INDEX),ORIENTATION_VECTOR(3,DV%ORIENTATION_INDEX),STATE_INDEX,0,' % ',TRIM(PY%ID)
   ENDIF
ENDDO

! Write out level set slice file name (placeholder)

IF (VEG_LEVEL_SET) THEN
   WRITE(LU_SMV,'(A,5X,2I3)') 'SLCT ',1,1 !terrain slice assumes one mesh and puts level set data on terrain
   WRITE(LU_SMV,'(A)') TRIM(CHID)//'_lsfs.sf'
   WRITE(LU_SMV,'(A)') 'phifield'
   WRITE(LU_SMV,'(A)') 'phifield'
   WRITE(LU_SMV,'(A)') '-'
ENDIF

! Write BDNE info

!BNDE_FILE_LOOP: DO N=1,N_BNDE

!   BE => BOUNDARY_ELEMENT_FILE(N)

!   WRITE(LU_SMV,'(/A)') 'BNDE'
!   WRITE(LU_SMV,'(1X,A)') FN_BNDE(N)
!   WRITE(LU_SMV,'(1X,A)') FN_GEOM(1)
!   WRITE(LU_SMV,'(1X,A)') TRIM(BE%SMOKEVIEW_LABEL(1:30))
!   WRITE(LU_SMV,'(1X,A)') TRIM(BE%SMOKEVIEW_BAR_LABEL(1:30))
!   WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(BE%INDEX)%UNITS(1:30))

!ENDDO BNDE_FILE_LOOP

ENDIF MASTER_NODE_IF

! Write out FN_BNDG, FN_BNDF_GEOM to .smv file:
IF (CC_IBM) THEN
   DO N = 1, N_BNDF
      BF => BOUNDARY_FILE(N)
      DO I = LOWER_MESH_INDEX,UPPER_MESH_INDEX
         ! Test if mesh overlaps with any bounding boxes of &GEOMS.
         FOUND_GEOM=.FALSE.
         DO IG=1,N_GEOMETRY
            G=>GEOMETRY(IG)
            IF(G%GEOM_BOX( LOW_IND,IAXIS) > MESHES(I)%XF) CYCLE
            IF(G%GEOM_BOX(HIGH_IND,IAXIS) < MESHES(I)%XS) CYCLE
            IF(G%GEOM_BOX( LOW_IND,JAXIS) > MESHES(I)%YF) CYCLE
            IF(G%GEOM_BOX(HIGH_IND,JAXIS) < MESHES(I)%YS) CYCLE
            IF(G%GEOM_BOX( LOW_IND,KAXIS) > MESHES(I)%ZF) CYCLE
            IF(G%GEOM_BOX(HIGH_IND,KAXIS) < MESHES(I)%ZS) CYCLE
            FOUND_GEOM=.TRUE.
         ENDDO
         IF(FOUND_GEOM)THEN
            WRITE(LU_SMV,'(/A)') 'BGEOM 0'
            WRITE(LU_SMV,'(1X,A)') FN_BNDF_GEOM(N,I)

            WRITE(LU_SMV,'(/A,2I6)') 'BNDE',I,1
            WRITE(LU_SMV,'(1X,A)') FN_BNDG(N,I)
            WRITE(LU_SMV,'(1X,A)') FN_BNDF_GEOM(N,I)
            WRITE(LU_SMV,'(1X,A)') TRIM(BF%SMOKEVIEW_LABEL(1:30))
            WRITE(LU_SMV,'(1X,A)') TRIM(BF%SMOKEVIEW_BAR_LABEL(1:30))
            WRITE(LU_SMV,'(1X,A)') TRIM(OUTPUT_QUANTITY(BF%INDEX)%UNITS(1:30))
         ENDIF
      ENDDO
   ENDDO
ENDIF

! Write out EVACUATION DEVICE info to .smv file (EXIT/DOOR/ENTR/EVSS)

EVAC_ONLY5: IF (ANY(EVACUATION_ONLY) .AND. MYID==MAX(0,EVAC_PROCESS)) THEN
   DO N=1,N_DOORS
      IF (.NOT.EVAC_DOORS(N)%SHOW) CYCLE
      XX = 0.5_EB*(EVAC_DOORS(N)%X1+EVAC_DOORS(N)%X2)
      YY = 0.5_EB*(EVAC_DOORS(N)%Y1+EVAC_DOORS(N)%Y2)
      ZZ = EVAC_DOORS(N)%Z
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacdoor'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,-EVAC_DOORS(N)%ORIENTATION(1:3),0,9
      ! x y z translate for the arrow (cone);  xx: upwards, yy: right, zz: towards the door
      IF (ABS(EVAC_DOORS(N)%IOR) <= 1) THEN
         WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_DOORS(N)%WIDTH, 0.05, EVAC_DOORS(N)%HEIGHT, EVAC_DOORS(N)%RGB(1:3)
         ZZ = (EVAC_DOORS(N)%Y - YY)
         YY = -EVAC_DOORS(N)%IOR*(EVAC_DOORS(N)%X - XX)
         XX = ZZ
         ZZ = EVAC_DOORS(N)%IOR*(0.5_EB*EVAC_DOORS(N)%HEIGHT + (EVAC_DOORS(N)%XYZ_Z - EVAC_DOORS(N)%Z))
      ELSE
         WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_DOORS(N)%HEIGHT, 0.05, EVAC_DOORS(N)%WIDTH, EVAC_DOORS(N)%RGB(1:3)
         YY = -EVAC_DOORS(N)%IOR*(EVAC_DOORS(N)%Y - YY)/2.0_EB
         ZZ = (EVAC_DOORS(N)%X - XX)
         XX = 0.5_EB*EVAC_DOORS(N)%IOR*(0.5_EB*EVAC_DOORS(N)%HEIGHT + (EVAC_DOORS(N)%XYZ_Z - EVAC_DOORS(N)%Z))
      ENDIF
      WRITE(LU_SMV,'(3F10.3)') ZZ, XX, YY
   ENDDO
   DO N=1,N_EXITS
      IF (EVAC_EXITS(N)%COUNT_ONLY .OR. .NOT.EVAC_EXITS(N)%SHOW) CYCLE
      XX = 0.5_EB*(EVAC_EXITS(N)%X1+EVAC_EXITS(N)%X2)
      YY = 0.5_EB*(EVAC_EXITS(N)%Y1+EVAC_EXITS(N)%Y2)
      ZZ = EVAC_EXITS(N)%Z
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacdoor'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,-EVAC_EXITS(N)%ORIENTATION(1:3),0,9
      ! x y z translate for the arrow (cone);  xx: upwards, yy: right, zz: towards the door
      IF (ABS(EVAC_EXITS(N)%IOR) <= 1) THEN
         WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_EXITS(N)%WIDTH, 0.05, EVAC_EXITS(N)%HEIGHT, EVAC_EXITS(N)%RGB(1:3)
         ZZ = (EVAC_EXITS(N)%Y - YY)
         YY = -EVAC_EXITS(N)%IOR*(EVAC_EXITS(N)%X - XX)
         XX = ZZ
         ZZ = EVAC_EXITS(N)%IOR*(0.5_EB*EVAC_EXITS(N)%HEIGHT + (EVAC_EXITS(N)%XYZ_Z - EVAC_EXITS(N)%Z))
      ELSE
         WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_EXITS(N)%HEIGHT, 0.05, EVAC_EXITS(N)%WIDTH, EVAC_EXITS(N)%RGB(1:3)
         YY = -EVAC_EXITS(N)%IOR*(EVAC_EXITS(N)%Y - YY)/2.0_EB
         ZZ = (EVAC_EXITS(N)%X - XX)
         XX = 0.5_EB*EVAC_EXITS(N)%IOR*(0.5_EB*EVAC_EXITS(N)%HEIGHT + (EVAC_EXITS(N)%XYZ_Z - EVAC_EXITS(N)%Z))
      ENDIF
      WRITE(LU_SMV,'(3F10.3)') ZZ, XX, YY
   ENDDO
   DO N=1,N_ENTRYS
      IF (.NOT.EVAC_ENTRYS(N)%SHOW) CYCLE
      XX = 0.5_EB*(EVAC_ENTRYS(N)%X1+EVAC_ENTRYS(N)%X2)
      YY = 0.5_EB*(EVAC_ENTRYS(N)%Y1+EVAC_ENTRYS(N)%Y2)
      ZZ = EVAC_ENTRYS(N)%Z
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacentr'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,-EVAC_ENTRYS(N)%ORIENTATION(1:3),0,6
      IF (ABS(EVAC_ENTRYS(N)%IOR) <= 1) THEN
         WRITE(LU_SMV,'(3F6.2,3I6)') EVAC_ENTRYS(N)%WIDTH, 0.05, EVAC_ENTRYS(N)%HEIGHT, EVAC_ENTRYS(N)%RGB(1:3)
      ELSE
         WRITE(LU_SMV,'(3F10.3,3I6)') EVAC_ENTRYS(N)%HEIGHT, 0.05, EVAC_ENTRYS(N)%WIDTH, EVAC_ENTRYS(N)%RGB(1:3)
      ENDIF
   ENDDO
   DO N=1,N_SSTANDS
      IF (.NOT.EVAC_SSTANDS(N)%SHOW) CYCLE
      XX = 0.5_EB*(EVAC_SSTANDS(N)%X1+EVAC_SSTANDS(N)%X2)
      YY = 0.5_EB*(EVAC_SSTANDS(N)%Y1+EVAC_SSTANDS(N)%Y2)
      ZZ = 0.5_EB*(EVAC_SSTANDS(N)%Z1+EVAC_SSTANDS(N)%Z2+EVAC_SSTANDS(N)%H+EVAC_SSTANDS(N)%H0) - &
           EVACUATION_Z_OFFSET(EVAC_SSTANDS(N)%IMESH)
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacincline'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,EVAC_SSTANDS(N)%ORIENTATION(1:3),0,6
      IF (ABS(EVAC_SSTANDS(N)%IOR) <= 1) THEN
         YY = ABS(EVAC_SSTANDS(N)%X2-EVAC_SSTANDS(N)%X1)/EVAC_SSTANDS(N)%COS_X
         XX = ABS(EVAC_SSTANDS(N)%Y2-EVAC_SSTANDS(N)%Y1)
      ELSE
         YY = ABS(EVAC_SSTANDS(N)%X2-EVAC_SSTANDS(N)%X1)
         XX = ABS(EVAC_SSTANDS(N)%Y2-EVAC_SSTANDS(N)%Y1)/EVAC_SSTANDS(N)%COS_Y
      ENDIF
      WRITE(LU_SMV,'(3F10.3,3I6)') XX, 0.1, YY, EVAC_SSTANDS(N)%RGB(1:3)
   ENDDO
   NN = 0
   DO N=1,NPC_EVAC
      IF (.NOT.EVAC_EVACS(N)%SHOW) CYCLE
      ! NN = NN + 1  ! I_EVAC_THIS_MESH is under construction
      NN = EVAC_EVACS(N)%I_EVAC_THIS_MESH
      XX = EVAC_EVACS(N)%X1
      YY = EVAC_EVACS(N)%Y1
      ZZ = 0.5_EB*(EVAC_EVACS(N)%Z1+EVAC_EVACS(N)%Z2)+0.05_EB*(NN-1)
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacbox'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,0.0,0.0,1.0,0,6
      XX = ABS(EVAC_EVACS(N)%X1-EVAC_EVACS(N)%X2)
      YY = ABS(EVAC_EVACS(N)%Y1-EVAC_EVACS(N)%Y2)
      WRITE(LU_SMV,'(3I6,3F10.3)')  EVAC_EVACS(N)%RGB(1:3), XX, YY, 0.05
   ENDDO
   NN = 0
   DO N=1,N_HOLES
      IF (.NOT.EVAC_HOLES(N)%SHOW) CYCLE
      ! NN = NN + 1  ! I_EVHO_THIS_MESH is under construction
      NN = EVAC_HOLES(N)%I_EVHO_THIS_MESH
      XX = EVAC_HOLES(N)%X1
      YY = EVAC_HOLES(N)%Y1
      ZZ = 0.5_EB*(EVAC_HOLES(N)%Z1+EVAC_HOLES(N)%Z2)+0.05_EB*(NN-1)
      WRITE(LU_SMV,'(/A)') 'DEVICE'
      WRITE(LU_SMV,'(A)') 'evacbox'
      WRITE(LU_SMV,'(6F12.5,2I2)') XX,YY,ZZ,0.0,0.0,1.0,0,6
      XX = ABS(EVAC_HOLES(N)%X1-EVAC_HOLES(N)%X2)
      YY = ABS(EVAC_HOLES(N)%Y1-EVAC_HOLES(N)%Y2)
      WRITE(LU_SMV,'(3I6,3F10.3)')  EVAC_HOLES(N)%RGB(1:3), XX, YY, 0.05
   ENDDO
END IF EVAC_ONLY5

! Write grid info for each block

MESH_LOOP: DO NM=1,NMESHES

   IF (PROCESS(NM)/=MYID) CYCLE

   M => MESHES(NM)
   T => TRANS(NM)

   WRITE(LU_SMV,'(/A)') 'OFFSET'
   WRITE(LU_SMV,'(3F13.5)') 0.,0.,0.

   WRITE(LU_SMV,'(/A,3X,A)') 'GRID',TRIM(MESH_NAME(NM))
   IF (.NOT.EVACUATION_ONLY(NM)) EVAC_CODE=0
   IF (     EVACUATION_ONLY(NM)) EVAC_CODE=2
   IF (     EVACUATION_SKIP(NM)) EVAC_CODE=1
   WRITE(LU_SMV,'(4I5)') M%IBAR,M%JBAR,M%KBAR,EVAC_CODE

   WRITE(LU_SMV,'(/A)') 'PDIM'
   WRITE(LU_SMV,'(9F14.5)') M%XS,M%XF,M%YS,M%YF,M%ZS,M%ZF,(REAL(M%RGB(I),FB)/255._FB,I = 1,3)

   WRITE(LU_SMV,'(/A)') 'TRNX'
   WRITE(LU_SMV,'(I5)') T%NOC(1)
   DO N=1,T%NOC(1)
      WRITE(LU_SMV,'(I5,2F14.5)') T%IDERIVSTORE(N,1),T%CCSTORE(N,1),T%PCSTORE(N,1)
   ENDDO
   DO I=0,M%IBAR
      WRITE(LU_SMV,'(I5,F14.5)') I,M%X(I)
   ENDDO

   WRITE(LU_SMV,'(/A)') 'TRNY'
   WRITE(LU_SMV,'(I5)') T%NOC(2)
   DO N=1,T%NOC(2)
      WRITE(LU_SMV,'(I5,2F14.5)') T%IDERIVSTORE(N,2),T%CCSTORE(N,2),T%PCSTORE(N,2)
   ENDDO
   DO J=0,M%JBAR
      WRITE(LU_SMV,'(I5,F14.5)') J,M%Y(J)
   ENDDO

   WRITE(LU_SMV,'(/A)') 'TRNZ'
   WRITE(LU_SMV,'(I5)') T%NOC(3)
   DO N=1,T%NOC(3)
      WRITE(LU_SMV,'(I5,2F14.5)') T%IDERIVSTORE(N,3),T%CCSTORE(N,3),T%PCSTORE(N,3)
   ENDDO
   DO K=0,M%KBAR
      WRITE(LU_SMV,'(I5,F14.5)') K,M%Z(K)
   ENDDO

   ! Write obstacle info to .smv file

   WRITE(LU_SMV,'(/A)') 'OBST'
   WRITE(LU_SMV,*) M%N_OBST
   DO N=1,M%N_OBST
      OB=>M%OBSTRUCTION(N)
      IF (OB%PROP_ID=='null') THEN
         TEMPCHAR=' '
      ELSE
         TEMPCHAR=' % '//TRIM(OB%PROP_ID)
      ENDIF
      IF (OB%TEXTURE(1)<=-998._EB) THEN
         WRITE(LU_SMV,'(6F14.5,I7,6I4,1X,A33)') OB%X1,OB%X2,OB%Y1,OB%Y2,OB%Z1,OB%Z2,OB%ORDINAL, &
            OB%SURF_INDEX(-1),OB%SURF_INDEX(1),OB%SURF_INDEX(-2),OB%SURF_INDEX(2),OB%SURF_INDEX(-3),OB%SURF_INDEX(3),TEMPCHAR
      ELSE
         WRITE(LU_SMV,'(6F14.5,I7,6I4,3F14.5,1X,A33)') OB%X1,OB%X2,OB%Y1,OB%Y2,OB%Z1,OB%Z2,OB%ORDINAL, &
            OB%SURF_INDEX(-1),OB%SURF_INDEX(1),OB%SURF_INDEX(-2),OB%SURF_INDEX(2),OB%SURF_INDEX(-3),OB%SURF_INDEX(3), &
            OB%TEXTURE(1),OB%TEXTURE(2),OB%TEXTURE(3),TEMPCHAR
      ENDIF
   ENDDO
   DO N=1,M%N_OBST
      OB=>M%OBSTRUCTION(N)
      TYPE_INDICATOR=OB%TYPE_INDICATOR
      IF (TERRAIN_CASE .AND. .NOT.OB%NOTERRAIN) THEN
         IF (TYPE_INDICATOR.GT.0) THEN
            TYPE_INDICATOR=TYPE_INDICATOR+8
         ELSE
            TYPE_INDICATOR=8
         ENDIF
      ENDIF
      IF (OB%COLOR_INDICATOR/=-3) THEN
         WRITE(LU_SMV,'(8I5)')        OB%I1,OB%I2,OB%J1,OB%J2,OB%K1,OB%K2,OB%COLOR_INDICATOR,TYPE_INDICATOR
      ELSE
         WRITE(LU_SMV,'(8I5,4F13.5)') OB%I1,OB%I2,OB%J1,OB%J2,OB%K1,OB%K2,OB%COLOR_INDICATOR,TYPE_INDICATOR, &
                                      REAL(OB%RGB,FB)/255._FB, OB%TRANSPARENCY
      ENDIF
   ENDDO

   ! Count circular vents

   N_CVENT=0
   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%RADIUS>0._EB) N_CVENT=N_CVENT+1
   ENDDO

   ! Replace vents on exterior mesh boundary with "dummy" vents to avoid overlap conflict in Smokeview

   NDV = 0
   NDVDIM = N_VENT_TOTAL + 1000
   ALLOCATE(DUMMY_VENT_INDEX(NDVDIM))
   ALLOCATE(IDV1(NDVDIM))
   ALLOCATE(IDV2(NDVDIM))
   ALLOCATE(JDV1(NDVDIM))
   ALLOCATE(JDV2(NDVDIM))
   ALLOCATE(KDV1(NDVDIM))
   ALLOCATE(KDV2(NDVDIM))
   ALLOCATE(VENT_INDICES(MAX(M%IBAR,M%JBAR),MAX(M%JBAR,M%KBAR),6))

   VENT_INDICES = 0

   VENT_LOOP: DO N=1,M%N_VENT

      VT=>M%VENTS(N)

      IF (VT%RADIUS>0._EB) CYCLE VENT_LOOP

      FACE_INDEX = 0
      IF (VT%I1==0      .AND. VT%I2==0     ) FACE_INDEX = 1
      IF (VT%I1==M%IBAR .AND. VT%I2==M%IBAR) FACE_INDEX = 2
      IF (VT%J1==0      .AND. VT%J2==0     ) FACE_INDEX = 3
      IF (VT%J1==M%JBAR .AND. VT%J2==M%JBAR) FACE_INDEX = 4
      IF (VT%K1==0      .AND. VT%K2==0     ) FACE_INDEX = 5
      IF (VT%K1==M%KBAR .AND. VT%K2==M%KBAR) FACE_INDEX = 6

      SELECT CASE(FACE_INDEX)  ! Get vent cell indices
         CASE(0)
            CYCLE VENT_LOOP
         CASE(1:2)
            HI1 = MAX(1,VT%J1+1)
            HI2 = MIN(M%JBAR,VT%J2)
            VI1 = MAX(1,VT%K1+1)
            VI2 = MIN(M%KBAR,VT%K2)
         CASE(3:4)
            HI1 = MAX(1,VT%I1+1)
            HI2 = MIN(M%IBAR,VT%I2)
            VI1 = MAX(1,VT%K1+1)
            VI2 = MIN(M%KBAR,VT%K2)
         CASE(5:6)
            HI1 = MAX(1,VT%I1+1)
            HI2 = MIN(M%IBAR,VT%I2)
            VI1 = MAX(1,VT%J1+1)
            VI2 = MIN(M%JBAR,VT%J2)
      END SELECT

      IF (VT%BOUNDARY_TYPE==MIRROR_BOUNDARY   .OR. &
          VT%BOUNDARY_TYPE==OPEN_BOUNDARY     .OR. &
          VT%BOUNDARY_TYPE==PERIODIC_BOUNDARY .OR. &
          VT%TYPE_INDICATOR==2) THEN
         WHERE (VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX)==0) VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX) = -1
      ELSE  ! Make solid color vents invisible (they will be replaced by dummy vents)
         WHERE (VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX)==0) VENT_INDICES(HI1:HI2,VI1:VI2,FACE_INDEX) = N
         VT%COLOR_INDICATOR =  8
         VT%TYPE_INDICATOR  = -2
         VT%TRANSPARENCY    =  0._EB
      ENDIF

   ENDDO VENT_LOOP

   ! Look for interpolated meshes and ensure that dummy vents are not drawn there

   DO K=1,M%KBAR
      J_LOOP1: DO J=1,M%JBAR
         YY = 0.5_EB*(M%Y(J)+M%Y(J-1))
         ZZ = 0.5_EB*(M%Z(K)+M%Z(K-1))
         XX = M%X(0) - 0.001_EB*M%DX(0)
         IF (INTERIOR(XX,YY,ZZ) .AND. (.NOT.M%SOLID(M%CELL_INDEX(0,J,K))        .OR. VENT_INDICES(J,K,1)<1)) VENT_INDICES(J,K,1)=-1
         XX = M%X(M%IBAR) + 0.001_EB*M%DX(M%IBAR)
         IF (INTERIOR(XX,YY,ZZ) .AND. (.NOT.M%SOLID(M%CELL_INDEX(M%IBAR+1,J,K)) .OR. VENT_INDICES(J,K,2)<1)) VENT_INDICES(J,K,2)=-1
      ENDDO J_LOOP1
   ENDDO

   DO K=1,M%KBAR
      I_LOOP1: DO I=1,M%IBAR
         XX = 0.5_EB*(M%X(I)+M%X(I-1))
         ZZ = 0.5_EB*(M%Z(K)+M%Z(K-1))
         YY = M%Y(0) - 0.001_EB*M%DY(0)
         IF (INTERIOR(XX,YY,ZZ) .AND. (.NOT.M%SOLID(M%CELL_INDEX(I,0,K))        .OR. VENT_INDICES(I,K,3)<1)) VENT_INDICES(I,K,3)=-1
         YY = M%Y(M%JBAR) + 0.001_EB*M%DY(M%JBAR)
         IF (INTERIOR(XX,YY,ZZ) .AND. (.NOT.M%SOLID(M%CELL_INDEX(I,M%JBAR+1,K)) .OR. VENT_INDICES(I,K,4)<1)) VENT_INDICES(I,K,4)=-1
      ENDDO I_LOOP1
   ENDDO

   DO J=1,M%JBAR
      I_LOOP2: DO I=1,M%IBAR
         XX = 0.5_EB*(M%X(I)+M%X(I-1))
         YY = 0.5_EB*(M%Y(J)+M%Y(J-1))
         ZZ = M%Z(0) - 0.001_EB*M%DZ(0)
         IF (INTERIOR(XX,YY,ZZ) .AND. (.NOT.M%SOLID(M%CELL_INDEX(I,J,0))        .OR. VENT_INDICES(I,J,5)<1)) VENT_INDICES(I,J,5)=-1
         ZZ = M%Z(M%KBAR) + 0.001_EB*M%DZ(M%KBAR)
         IF (INTERIOR(XX,YY,ZZ) .AND. (.NOT.M%SOLID(M%CELL_INDEX(I,J,M%KBAR+1)) .OR. VENT_INDICES(I,J,6)<1)) VENT_INDICES(I,J,6)=-1
      ENDDO I_LOOP2
   ENDDO

   ! Create dummy vents to fill in areas around actual specified vents

   CALL DUMMY_VENTS(1,M%JBAR,M%KBAR,JDV1,JDV2,KDV1,KDV2,0     ,IDV1,IDV2)
   CALL DUMMY_VENTS(2,M%JBAR,M%KBAR,JDV1,JDV2,KDV1,KDV2,M%IBAR,IDV1,IDV2)
   CALL DUMMY_VENTS(3,M%IBAR,M%KBAR,IDV1,IDV2,KDV1,KDV2,0     ,JDV1,JDV2)
   CALL DUMMY_VENTS(4,M%IBAR,M%KBAR,IDV1,IDV2,KDV1,KDV2,M%JBAR,JDV1,JDV2)
   CALL DUMMY_VENTS(5,M%IBAR,M%JBAR,IDV1,IDV2,JDV1,JDV2,0     ,KDV1,KDV2)
   CALL DUMMY_VENTS(6,M%IBAR,M%JBAR,IDV1,IDV2,JDV1,JDV2,M%KBAR,KDV1,KDV2)

   DEALLOCATE(VENT_INDICES)

   ! Write out information about vents to Smokeview file

   WRITE(LU_SMV,'(/A)') 'VENT'
   WRITE(LU_SMV,'(2I5)') M%N_VENT-N_CVENT+NDV,NDV

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%RADIUS>0._EB) CYCLE
      WRITE(LU_SMV,'(6F14.5,I6,I4,3F14.5)') VT%X1,VT%X2,VT%Y1,VT%Y2,VT%Z1,VT%Z2,VT%ORDINAL,VT%SURF_INDEX, &
                                            VT%TEXTURE(1),VT%TEXTURE(2),VT%TEXTURE(3)
   ENDDO

   DO N=1,NDV
      SURF_INDEX = DEFAULT_SURF_INDEX
      IF (DUMMY_VENT_INDEX(N)>0) SURF_INDEX=M%VENTS(DUMMY_VENT_INDEX(N))%SURF_INDEX
      WRITE(LU_SMV,'(6F14.5,I6,I4)') M%X(IDV1(N)),M%X(IDV2(N)),M%Y(JDV1(N)),M%Y(JDV2(N)),  &
                                     M%Z(KDV1(N)),M%Z(KDV2(N)),M%N_VENT+N,SURF_INDEX
   ENDDO

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%RADIUS>0._EB) CYCLE
      IF (VT%BOUNDARY_TYPE==OPEN_BOUNDARY) COLOR_INDEX = -VT%COLOR_INDICATOR
      IF (VT%BOUNDARY_TYPE/=OPEN_BOUNDARY) COLOR_INDEX =  VT%COLOR_INDICATOR
      IF (VT%RGB(1)<0) THEN
         WRITE(LU_SMV,'(8I5)')        MAX(0,VT%I1),MIN(M%IBAR,VT%I2), &
                                      MAX(0,VT%J1),MIN(M%JBAR,VT%J2), &
                                      MAX(0,VT%K1),MIN(M%KBAR,VT%K2),COLOR_INDEX,VT%TYPE_INDICATOR
      ELSE
         WRITE(LU_SMV,'(8I5,4F13.5)') MAX(0,VT%I1),MIN(M%IBAR,VT%I2), &
                                      MAX(0,VT%J1),MIN(M%JBAR,VT%J2), &
                                      MAX(0,VT%K1),MIN(M%KBAR,VT%K2),COLOR_INDEX,VT%TYPE_INDICATOR, &
                                      REAL(VT%RGB,FB)/255._FB,VT%TRANSPARENCY
      ENDIF
   ENDDO
   DO N=1,NDV
      COLOR_INDEX = 99
      TYPE_INDEX  = 0
      VRGB        = -1
      IF (DUMMY_VENT_INDEX(N)>0) VRGB = M%VENTS(DUMMY_VENT_INDEX(N))%RGB
      IF (VRGB(1)<0) THEN
         WRITE(LU_SMV,'(8I5)') IDV1(N),IDV2(N),JDV1(N),JDV2(N),KDV1(N),KDV2(N),COLOR_INDEX,TYPE_INDEX
      ELSE
         WRITE(LU_SMV,'(8I5,4F13.5)') IDV1(N),IDV2(N),JDV1(N),JDV2(N),KDV1(N),KDV2(N),COLOR_INDEX,TYPE_INDEX, &
                                      REAL(VRGB,FB)/255._FB,1._EB
      ENDIF
   ENDDO

   DEALLOCATE(IDV1)
   DEALLOCATE(IDV2)
   DEALLOCATE(JDV1)
   DEALLOCATE(JDV2)
   DEALLOCATE(KDV1)
   DEALLOCATE(KDV2)
   DEALLOCATE(DUMMY_VENT_INDEX)

   ! Write out information about circular vents to Smokeview file

   WRITE(LU_SMV,'(/A)') 'CVENT'
   WRITE(LU_SMV,'(1I5)') N_CVENT

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%RADIUS<0._EB) CYCLE
      WRITE(LU_SMV,'(6F14.5,I6,I4,3F14.5,A,4F13.5)') VT%X1,VT%X2,VT%Y1,VT%Y2,VT%Z1,VT%Z2,VT%ORDINAL,VT%SURF_INDEX, &
         VT%TEXTURE(1),VT%TEXTURE(2),VT%TEXTURE(3),'  %  ',VT%X0,VT%Y0,VT%Z0,VT%RADIUS
   ENDDO

   DO N=1,M%N_VENT
      VT=>M%VENTS(N)
      IF (VT%RADIUS<0._EB) CYCLE
      IF (VT%BOUNDARY_TYPE==OPEN_BOUNDARY) COLOR_INDEX = -VT%COLOR_INDICATOR
      IF (VT%BOUNDARY_TYPE/=OPEN_BOUNDARY) COLOR_INDEX =  VT%COLOR_INDICATOR
      IF (VT%RGB(1)<0) THEN
         WRITE(LU_SMV,'(8I5)')        MAX(0,VT%I1),MIN(M%IBAR,VT%I2), &
                                      MAX(0,VT%J1),MIN(M%JBAR,VT%J2), &
                                      MAX(0,VT%K1),MIN(M%KBAR,VT%K2),COLOR_INDEX,VT%TYPE_INDICATOR
      ELSE
         WRITE(LU_SMV,'(8I5,4F13.5)') MAX(0,VT%I1),MIN(M%IBAR,VT%I2), &
                                      MAX(0,VT%J1),MIN(M%JBAR,VT%J2), &
                                      MAX(0,VT%K1),MIN(M%KBAR,VT%K2),COLOR_INDEX,VT%TYPE_INDICATOR, &
                                      REAL(VT%RGB,FB)/255._FB,VT%TRANSPARENCY
      ENDIF
   ENDDO

   WRITE(LU_SMV,'()') ! skip line

ENDDO MESH_LOOP

! Flush the .smv file

CLOSE(LU_SMV)


CONTAINS


SUBROUTINE DUMMY_VENTS(FI,N1,N2,IVV1,IVV2,JVV1,JVV2,N3,KVV1,KVV2)

! For exterior mesh face, FI, create "dummy" vent patches for Smokeview

INTEGER, INTENT(IN) :: N1,N2,N3,FI
INTEGER, INTENT(INOUT), DIMENSION(NDVDIM) :: IVV1,IVV2,JVV1,JVV2,KVV1,KVV2
INTEGER :: I,J,II,JJ,ISTP,JSTP,VENT_INDEX

JLOOP: DO J=1,N2
   ILOOP: DO I=1,N1

      IF (VENT_INDICES(I,J,FI)==-1) CYCLE ILOOP
      VENT_INDEX = VENT_INDICES(I,J,FI)

      ISTP = N1
      JSTP = N2
      JJLOOP: DO JJ=J+1,N2
         IF (VENT_INDICES(I,JJ,FI)/=VENT_INDEX) THEN
            JSTP = JJ-1
            EXIT JJLOOP
         ENDIF
      ENDDO JJLOOP

      IILOOP: DO II=I+1,N1
         JJLOOP2: DO JJ=J,JSTP
         IF (VENT_INDICES(II,JJ,FI)/=VENT_INDEX) THEN
            ISTP = II-1
            EXIT IILOOP
         ENDIF
         ENDDO JJLOOP2
      ENDDO IILOOP

      NDV = NDV + 1
      VENT_INDICES(I:ISTP,J:JSTP,FI) = -1
      IVV1(NDV) = I-1
      IVV2(NDV) = ISTP
      JVV1(NDV) = J-1
      JVV2(NDV) = JSTP
      KVV1(NDV) = N3
      KVV2(NDV) = N3
      DUMMY_VENT_INDEX(NDV) = VENT_INDEX

   ENDDO ILOOP
ENDDO JLOOP

END SUBROUTINE DUMMY_VENTS


SUBROUTINE RE_ALLOCATE_SEGMENTS
USE MEMORY_FUNCTIONS, ONLY : ChkMemErr
TYPE(SEGMENT_TYPE), ALLOCATABLE, DIMENSION(:) :: DUMMY_SEGMENT
INTEGER :: IZERO

ALLOCATE(DUMMY_SEGMENT(N_SEGMENTS_MAX),STAT=IZERO)
CALL ChkMemErr('DUMP','DUMMY_SEGMENT',IZERO)
DUMMY_SEGMENT(1:N_SEGMENTS_MAX) = SEGMENT(1:N_SEGMENTS_MAX)

DEALLOCATE(SEGMENT)
ALLOCATE(SEGMENT(N_SEGMENTS_MAX+100),STAT=IZERO)
CALL ChkMemErr('DUMP','SEGMENT',IZERO)
SEGMENT(1:N_SEGMENTS_MAX) = DUMMY_SEGMENT(1:N_SEGMENTS_MAX)
N_SEGMENTS_MAX = N_SEGMENTS_MAX + 100

DEALLOCATE(DUMMY_SEGMENT)

END SUBROUTINE RE_ALLOCATE_SEGMENTS


END SUBROUTINE WRITE_SMOKEVIEW_FILE


SUBROUTINE WRITE_STATUS_FILES

! Status files are used to indicate how FDS ended

IF (STATUS_FILES) THEN
   OPEN(LU_NOTREADY,FILE=FN_NOTREADY,FORM='FORMATTED',STATUS='REPLACE')
   WRITE(LU_NOTREADY,'(A ,A/)') ' Job ID string: ', TRIM(CHID)
ENDIF

END SUBROUTINE WRITE_STATUS_FILES


SUBROUTINE INITIALIZE_DIAGNOSTIC_FILE(DT)

USE RADCONS, ONLY: NRT,RSA,NRP,TIME_STEP_INCREMENT,PATH_LENGTH
USE MATH_FUNCTIONS, ONLY : EVALUATE_RAMP
USE MISC_FUNCTIONS, ONLY : WRITE_SUMMARY_INFO
USE SCRC, ONLY: SCARC_METHOD, SCARC_DISCRETIZATION, SCARC_MULTIGRID, SCARC_SMOOTH, SCARC_PRECON, &
                SCARC_COARSE, SCARC_MULTIGRID_CYCLE, SCARC_MULTIGRID_COARSENING, &
                SCARC_MULTIGRID_ITERATIONS, SCARC_MULTIGRID_ACCURACY, SCARC_MULTIGRID_INTERPOL, &
                SCARC_KRYLOV_ITERATIONS, SCARC_KRYLOV_ACCURACY

REAL(EB), INTENT(IN) :: DT
INTEGER :: NM,I,NN,N,NR,NL,NS,ITMP, CELL_COUNT
CHARACTER(LABEL_LENGTH) :: QUANTITY,ODE_SOLVER,OUTFORM
TYPE(SPECIES_MIXTURE_TYPE),POINTER :: SM=>NULL()

! Write out preliminary stuff to error file (unit 0)

CALL WRITE_SUMMARY_INFO(LU_ERR)

WRITE(LU_ERR,'(/A,A)')     ' Job TITLE        : ',TRIM(TITLE)
WRITE(LU_ERR,'(A,A/)')     ' Job ID string    : ',TRIM(CHID)

! Open and initialize diagnostic output file

IF (APPEND) THEN
   INQUIRE(FILE=FN_OUTPUT,EXIST=EX)
   IF (EX) OPEN(LU_OUTPUT,FILE=FN_OUTPUT,FORM='FORMATTED',STATUS='OLD',POSITION='APPEND')
ELSE
   OPEN(LU_OUTPUT,FILE=FN_OUTPUT,FORM='FORMATTED',STATUS='REPLACE')
ENDIF

OUT_FILE_OPENED = .TRUE.

! Write out the input parameters to output file (unit 6)

CALL WRITE_SUMMARY_INFO(LU_OUTPUT)

WRITE(LU_OUTPUT,'(/A,A)')     ' Job TITLE        : ',TRIM(TITLE)
WRITE(LU_OUTPUT,'(A,A/)')     ' Job ID string    : ',TRIM(CHID)

IF (APPEND) RETURN

IF (.NOT.SUPPRESS_DIAGNOSTICS) THEN
   CELL_COUNT = 0
   MESH_LOOP: DO NM=1,NMESHES
      M => MESHES(NM)
      WRITE(LU_OUTPUT,'(/A,I5/)') ' Grid Dimensions, Mesh ',NM
      WRITE(LU_OUTPUT,'(A,I8)')     '   Cells in the X Direction      ',M%IBAR
      WRITE(LU_OUTPUT,'(A,I8)')     '   Cells in the Y Direction      ',M%JBAR
      WRITE(LU_OUTPUT,'(A,I8)')     '   Cells in the Z Direction      ',M%KBAR
      WRITE(LU_OUTPUT,'(A,I8)')     '   Number of Grid Cells          ',M%IBAR*M%JBAR*M%KBAR
      CELL_COUNT = CELL_COUNT + M%IBAR*M%JBAR*M%KBAR
      WRITE(LU_OUTPUT,'(//A,I5/)')' Physical Dimensions, Mesh ',NM
      WRITE(LU_OUTPUT,'(A,F10.3)')  '   Length (m)                  ',M%XF-M%XS
      WRITE(LU_OUTPUT,'(A,F10.3)')  '   Width  (m)                  ',M%YF-M%YS
      WRITE(LU_OUTPUT,'(A,F10.3)')  '   Height (m)                  ',M%ZF-M%ZS
      WRITE(LU_OUTPUT,'(A,F10.3)')  '   Initial Time Step (s)       ',DT
   ENDDO MESH_LOOP
   WRITE(LU_OUTPUT,'(/A,I9)')    'Total Number of Grid Cells     ',CELL_COUNT
ENDIF

WRITE(LU_OUTPUT,'(//A/)')     ' Miscellaneous Parameters'
IF (ABS(TIME_SHRINK_FACTOR -1._EB)>SPACING(1._EB)) &
WRITE(LU_OUTPUT,'(A,F8.1)')   '   Time Shrink Factor (s/s)      ',TIME_SHRINK_FACTOR
WRITE(LU_OUTPUT,'(A,F8.1)')   '   Simulation Start Time (s)     ',T_BEGIN
WRITE(LU_OUTPUT,'(A,F8.1)')   '   Simulation End Time (s)       ',(T_END-T_BEGIN) * TIME_SHRINK_FACTOR + T_BEGIN
IF (SIM_MODE/=DNS_MODE) THEN
   WRITE(LU_OUTPUT,'(A)')     '   LES Calculation'
   TURB_MODEL_SELECT: SELECT CASE (TURB_MODEL)
      CASE(CONSMAG)
         WRITE(LU_OUTPUT,'(A,F4.2,A)')    '   Eddy Viscosity:           Smagorinsky (C_SMAGORINSKY = ',C_SMAGORINSKY,')'
      CASE(DYNSMAG)
         WRITE(LU_OUTPUT,'(A)')           '   Eddy Viscosity:           Dynamic Smagorinsky Model'
      CASE(DEARDORFF)
         WRITE(LU_OUTPUT,'(A,F4.2,A)')    '   Eddy Viscosity:           Deardorff Model (C_DEARDORFF = ',C_DEARDORFF,')'
      CASE(VREMAN)
         WRITE(LU_OUTPUT,'(A,F4.2,A)')    '   Eddy Viscosity:           Vreman Model (C_VREMAN = ',C_VREMAN,')'
      CASE(RNG)
         WRITE(LU_OUTPUT,'(A,F7.2,F7.2)') '   Eddy Viscosity:           RNG Model (C_RNG,C_RNG_CUTOFF) ',C_RNG,C_RNG_CUTOFF
      CASE(WALE)
         WRITE(LU_OUTPUT,'(A,F4.2,A)')    '   Eddy Viscosity:           WALE Model (C_WALE = ',C_WALE,')'
   END SELECT TURB_MODEL_SELECT
   NEAR_WALL_SELECT: SELECT CASE (NEAR_WALL_TURB_MODEL)
      CASE DEFAULT
         WRITE(LU_OUTPUT,'(A,F4.2,A)')    '   Near-wall Eddy Viscosity: Smagorinsky with Van Driest damping (C_SMAGORINSKY = ',&
            C_SMAGORINSKY,')'
      CASE(WALE)
         WRITE(LU_OUTPUT,'(A,F4.2,A)')    '   Near-wall Eddy Viscosity: WALE Model (C_WALE = ',C_WALE,')'
   END SELECT NEAR_WALL_SELECT
   WRITE(LU_OUTPUT,'(A,F8.2)')   '   Turbulent Prandtl Number      ',PR
   WRITE(LU_OUTPUT,'(A,F8.2)')   '   Turbulent Schmidt Number      ',SC
ENDIF
WRITE(LU_OUTPUT,'(A,F8.2)')   '   Ambient Temperature (C)       ',TMPA-TMPM

! Write out the transformation matrix that converts species mixtures to primitive species

WRITE(LU_OUTPUT,'(//A/)') ' Mass Fraction Transformation Matrix to Convert Species Mixtures (Columns) to Primitive Species (Rows)'

WRITE(LU_OUTPUT,'(25X,100(A8,2X))') (SPECIES_MIXTURE(N)%ID,N=1,N_TRACKED_SPECIES)
DO NN=1,N_SPECIES
   WRITE(LU_OUTPUT,'(3X,A20,100F10.6)') SPECIES(NN)%ID,(Z2Y(NN,N),N=1,N_TRACKED_SPECIES)
ENDDO

! Print out information about species

WRITE(LU_OUTPUT,'(//A)') ' Primitive Species Information'
SPEC_LOOP: DO N=1,N_SPECIES
   SS => SPECIES(N)
   WRITE(LU_OUTPUT,'(/3X,A)') TRIM(SS%ID)
   SELECT CASE(SS%MODE)
      CASE (GAS_SPECIES)
         WRITE(LU_OUTPUT,'( 3X,A)') 'Gas Species'
      CASE (AEROSOL_SPECIES)
         WRITE(LU_OUTPUT,'( 3X,A)') 'Aerosol'
   END SELECT
   WRITE(LU_OUTPUT,'(A,F11.5)')   '   Molecular Weight (g/mol)         ',SS%MW
   WRITE(LU_OUTPUT,'(A,F8.3)')    '   Ambient Density (kg/m^3)         ',SS%MW*P_INF/(TMPA*R0)
   IF (SS%H_F < -1.E23_EB) THEN
      WRITE(LU_OUTPUT,'(A,A)')    '   Enthalpy of Formation (J/kg)     ','not specified'
   ELSE
      WRITE(LU_OUTPUT,'(A,ES9.2)')'   Enthalpy of Formation (J/kg)       ',SS%H_F/SS%MW*1000._EB
   ENDIF
ENDDO SPEC_LOOP

! Write lumped species summary

WRITE(LU_OUTPUT,'(//A)') ' Tracked (Lumped) Species Information'

DO N=1,N_TRACKED_SPECIES
   SM=>SPECIES_MIXTURE(N)
   WRITE(LU_OUTPUT,'(/3X,A)') TRIM(SM%ID)
   WRITE(LU_OUTPUT,'(A,F11.5)')   '   Molecular Weight (g/mol)         ',SM%MW
   WRITE(LU_OUTPUT,'(A,F8.3)')    '   Ambient Density (kg/m^3)         ',SM%MW*P_INF/(TMPA*R0)
   WRITE(LU_OUTPUT,'(A,F8.3)')    '   Initial Mass Fraction            ',SM%ZZ0
   WRITE(LU_OUTPUT,'(A,ES9.2)')   '   Enthalpy of Formation (J/kg)     ',SM%H_F
   WRITE(LU_OUTPUT,'(/3X,A)') 'Sub Species                    Mass Fraction     Mole Fraction'
   DO NN = 1,N_SPECIES
      IF (SM%SPEC_ID(NN)/='null') WRITE(LU_OUTPUT,'( 3X,A29,A,ES13.6,5X,ES13.6)') &
         SM%SPEC_ID(NN),' ',SM%MASS_FRACTION(NN),SM%VOLUME_FRACTION(NN)
   ENDDO
   ITMP = NINT(TMPA)
   WRITE(LU_OUTPUT,'(A)') ' '
   WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '     Viscosity (kg/m/s) Ambient, ',ITMP,' K: ', MU_RSQMW_Z(ITMP,N)/RSQ_MW_Z(N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                  500 K: ', MU_RSQMW_Z( 500,N)/RSQ_MW_Z(N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                 1000 K: ', MU_RSQMW_Z(1000,N)/RSQ_MW_Z(N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                 1500 K: ', MU_RSQMW_Z(1500,N)/RSQ_MW_Z(N)
   WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '   Therm. Cond. (W/m/K) Ambient, ',ITMP,' K: ', K_RSQMW_Z(ITMP,N)/RSQ_MW_Z(N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                  500 K: ', K_RSQMW_Z( 500,N)/RSQ_MW_Z(N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                 1000 K: ', K_RSQMW_Z(1000,N)/RSQ_MW_Z(N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                 1500 K: ', K_RSQMW_Z(1500,N)/RSQ_MW_Z(N)
   WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '        Enthalpy (J/kg) Ambient, ',ITMP,' K: ', CPBAR_Z(ITMP,N)*TMPA
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                  500 K: ', CPBAR_Z(500,N)*500._EB
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                 1000 K: ', CPBAR_Z(1000,N)*1000._EB
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                 1500 K: ', CPBAR_Z(1500,N)*1500._EB
   WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '    Spec. Heat (J/kg/K) Ambient, ',ITMP,' K: ', CP_Z(ITMP,N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                  500 K: ', CP_Z( 500,N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                 1000 K: ', CP_Z(1000,N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                 1500 K: ', CP_Z(1500,N)
   WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '   Diff. Coeff. (m^2/s) Ambient, ',ITMP,' K: ', D_Z(ITMP,N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                  500 K: ', D_Z( 500,N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                 1000 K: ', D_Z(1000,N)
   WRITE(LU_OUTPUT,'(A,ES9.2)')  '                                 1500 K: ', D_Z(1500,N)
   IF (SM%EVAPORATING) THEN
      WRITE(LU_OUTPUT,'(A)') ' '
      SS => SPECIES(SM%SINGLE_SPEC_INDEX)
      ITMP = MIN(NINT(SS%TMP_MELT),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '   Liq. Enthalpy (J/kg)     Melt ',ITMP,' K: ', &
         SS%C_P_L_BAR(ITMP)*SS%TMP_MELT
      ITMP = MIN(NINT(0.5_EB*(SS%TMP_V+SS%TMP_MELT)),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '                                 ',ITMP,' K: ', &
         SS%C_P_L_BAR(ITMP)*0.5_EB*(SS%TMP_V+SS%TMP_MELT)
      ITMP = MIN(NINT(SS%TMP_V),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '                            Boil ',ITMP,' K: ', &
         SS%C_P_L_BAR(ITMP)*SS%TMP_V
      WRITE(LU_OUTPUT,'(A)') ' '
      SS => SPECIES(SM%SINGLE_SPEC_INDEX)
      ITMP = MIN(NINT(SS%TMP_MELT),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '   Liq. Spec. Heat (J/kg/K) Melt ',ITMP,' K: ', SS%C_P_L(ITMP)
      ITMP = MIN(NINT(0.5_EB*(SS%TMP_V+SS%TMP_MELT)),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '                                 ',ITMP,' K: ', SS%C_P_L(ITMP)
      ITMP = MIN(NINT(SS%TMP_V),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '                            Boil ',ITMP,' K: ', SS%C_P_L(ITMP)
      WRITE(LU_OUTPUT,'(A)') ' '
      ITMP = MIN(NINT(SS%TMP_MELT),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '   Heat of Vapor. (J/kg)    Melt ',ITMP,' K: ', SS%H_V(ITMP)
      ITMP = MIN(NINT(0.5_EB*(SS%TMP_V+SS%TMP_MELT)),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '                                 ',ITMP,' K: ', SS%H_V(ITMP)
      ITMP = MIN(NINT(SS%TMP_V),5000)
      WRITE(LU_OUTPUT,'(A,I4,A,ES9.2)')  '                            Boil ',ITMP,' K: ', SS%H_V(ITMP)
   ENDIF
ENDDO

! Print out Stoichiometric parameters for reactions

IF (N_REACTIONS>0) WRITE(LU_OUTPUT,'(//A)') ' Gas Phase Reaction Information'

REACTION_LOOP: DO N=1,N_REACTIONS
   RN => REACTION(N)
   SELECT CASE (COMBUSTION_ODE_SOLVER)
      CASE (EXPLICIT_EULER)
         ODE_SOLVER = 'EXPLICIT EULER'
      CASE (RK2_RICHARDSON)
         ODE_SOLVER = 'RK2 RICHARDSON'
   END SELECT
   SELECT CASE (EXTINCT_MOD)
      CASE (EXTINCTION_1)
         EXTINCTION_MODEL = 'EXTINCTION 1'
      CASE (EXTINCTION_2)
         EXTINCTION_MODEL = 'EXTINCTION 2'
      CASE (EXTINCTION_3)
         EXTINCTION_MODEL = 'EXTINCTION 3'
   END SELECT

   IF (RN%FYI/='null') WRITE(LU_OUTPUT,'(/3X,A)') TRIM(RN%FYI)
   IF (RN%ID/='null')  WRITE(LU_OUTPUT,'(/3X,A,A)')   'Reaction ID:  ', TRIM(RN%ID)
   IF (RN%REVERSE)     WRITE(LU_OUTPUT,'(/3X,A,A)')   'Reverse Reaction of ID:  ', TRIM(RN%FWD_ID)

   WRITE(LU_OUTPUT,'(/3X,A)')     'Fuel                                           Heat of Combustion (kJ/kg)'
   WRITE(LU_OUTPUT,'(3X,A,1X,F12.4)') RN%FUEL,RN%HEAT_OF_COMBUSTION/1000._EB

   WRITE(LU_OUTPUT,'(/3X,A)')     'Stoichiometry'

   WRITE(LU_OUTPUT,'(/3X,A)')     'Primitive Species Stoich. Coeff.'
   WRITE(LU_OUTPUT,'(3X,A)')      'Species ID                                                          Molar'
   DO NN=1,N_SPECIES
      IF (ABS(RN%NU_SPECIES(NN))<=TWO_EPSILON_EB) CYCLE
      WRITE(OUTFORM,'(A,I1,A,I1,A)') '(3X,A,1X,F12.',MAX(1,MIN(6,8-INT(LOG10(ABS(RN%NU_SPECIES(NN))))+1)),')'
      WRITE(LU_OUTPUT,OUTFORM) SPECIES(NN)%ID,RN%NU_SPECIES(NN)
   ENDDO

   WRITE(LU_OUTPUT,'(/3X,A)')     'Tracked (Lumped) Species Stoich. Coeff.'
   WRITE(LU_OUTPUT,'(3X,A)')      'Species ID                                             Molar         Mass'
   DO NN=1,N_TRACKED_SPECIES
      IF (ABS(RN%NU(NN)) < TWO_EPSILON_EB) CYCLE
      WRITE(OUTFORM,'(A,I1,A,I1,A)') '(3X,A,1X,F12.',MAX(1,MIN(6,8-INT(LOG10(ABS(RN%NU(NN))))+1)),',1X,F12.', &
         MAX(1,MIN(6,8-INT(LOG10(ABS(RN%NU(NN))*SPECIES_MIXTURE(NN)%MW/SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)%MW))+1)),')'
      WRITE(LU_OUTPUT,OUTFORM) SPECIES_MIXTURE(NN)%ID(1:47),RN%NU(NN),&
         RN%NU(NN)*SPECIES_MIXTURE(NN)%MW/SPECIES_MIXTURE(RN%FUEL_SMIX_INDEX)%MW
   ENDDO

   WRITE(LU_OUTPUT,'(/3X,A)')     'Reaction Kinetics'

   WRITE(LU_OUTPUT,'(/3X,A)')              'Arrhenius Parameters'
   IF (RN%FAST_CHEMISTRY) THEN
      WRITE(LU_OUTPUT,'(3X,A)')            'Pre-exponential:    Infinite'
      WRITE(LU_OUTPUT,'(3X,A)')            'Activation Energy:  N/A'
   ELSE
      WRITE(LU_OUTPUT,'(3X,A,1X,ES13.6)')  'Pre-exponential ((mol/cm^3)^(1-order)/s): ',RN%A_IN
      WRITE(LU_OUTPUT,'(3X,A,1X,ES13.6)')  'Activation Energy (J/mol):                ',RN%E_IN
   ENDIF
   IF (.NOT.RN%FAST_CHEMISTRY) THEN
      WRITE(LU_OUTPUT,'(/3X,A)')  'Species ID                                                  Rate Exponent'
      DO NN=1,N_SPECIES
         IF (RN%N_S(NN) <=-998._EB) CYCLE
         WRITE(LU_OUTPUT,'(3X,A,1X,F12.6)') SPECIES(NN)%ID,RN%N_S(NN)
      ENDDO
      IF (ABS(RN%N_T)>TWO_EPSILON_EB) WRITE(LU_OUTPUT,'(3X,A,50X,F12.6)') 'Temperature',RN%N_T
   ENDIF

   WRITE(LU_OUTPUT,'(/3X,A,A)')      'ODE Solver:  ', TRIM(ODE_SOLVER)
   IF (N_FIXED_CHEMISTRY_SUBSTEPS>0) THEN
      WRITE(LU_OUTPUT,'(/3X,A,I3)')  'Number of Fixed Substeps:  ', N_FIXED_CHEMISTRY_SUBSTEPS
   ENDIF
   IF (SUPPRESSION .AND. RN%FAST_CHEMISTRY) THEN
      WRITE(LU_OUTPUT,'(3X,A,A)')    'Extinction Model:  ', TRIM(EXTINCTION_MODEL)
      WRITE(LU_OUTPUT,'(3X,A,F8.1)') 'Ignition Temperature (K):       ', RN%AUTO_IGNITION_TEMPERATURE
      WRITE(LU_OUTPUT,'(3X,A,F8.1)') 'Critical Flame Temperature (K): ', RN%CRIT_FLAME_TMP
   ENDIF

ENDDO REACTION_LOOP

! Print out information about agglomeration

IF (AGGLOMERATION_INDEX>0) THEN
   WRITE(LU_OUTPUT,'(//A)')    ' Agglomeration Information'
   WRITE(LU_OUTPUT,'(/A,A)')   '     Agglomerating Species:         ',&
                                     TRIM(SPECIES(SPECIES_MIXTURE(AGGLOMERATION_INDEX)%SINGLE_SPEC_INDEX)%ID)
   WRITE(LU_OUTPUT,'(A,I0)')   '     Number of Particle Bins:       ',N_PARTICLE_BINS
   WRITE(LU_OUTPUT,'(A,F9.3)') '     Particle Density (kg/m^3):     ',SPECIES_MIXTURE(AGGLOMERATION_INDEX)%DENSITY_SOLID
   WRITE(LU_OUTPUT,'(A,F8.3)') '     Minimum Particle Diameter (um):',MIN_PARTICLE_DIAMETER*1.E6_EB
   WRITE(LU_OUTPUT,'(A,F8.3)') '     Maximum Particle Diameter (um):',MAX_PARTICLE_DIAMETER*1.E6_EB
   WRITE(LU_OUTPUT,'(A)')      '     Bin #  Bin Diameter (um)'
   DO N=1,N_PARTICLE_BINS
      WRITE(LU_OUTPUT,'(A,I3,A,F8.3)') '     ',N,'        ',2._EB*PARTICLE_RADIUS(N)*1.E6_EB
   ENDDO
ENDIF

! Print out information about materials

WRITE(LU_OUTPUT,'(//A,I2)')  ' Material Information'

MATL_LOOP: DO N=1,N_MATL
   ML => MATERIAL(N)
   WRITE(LU_OUTPUT,'(/I4,1X,A)')    N,MATL_NAME(N)
   IF (ML%FYI/='null') WRITE(LU_OUTPUT,'(5X,A)') TRIM(ML%FYI)
   WRITE(LU_OUTPUT,'(A,F8.3)')    '     Emissivity                   ',ML%EMISSIVITY
   WRITE(LU_OUTPUT,'(A,F8.1)')    '     Density (kg/m3)              ',ML%RHO_S
   IF (ML%C_S>0._EB) THEN
      WRITE(LU_OUTPUT,'(A,ES9.2)') '     Specific Heat (kJ/kg/K)     ',ML%C_S*0.001_EB
   ELSE
      NR = -NINT(ML%C_S)
      WRITE(LU_OUTPUT,'(A,ES9.2)') '     Specific Heat (kJ/kg/K)     ',EVALUATE_RAMP(TMPA,0._EB,NR)*0.001_EB
   ENDIF
   IF (ML%K_S>0._EB) THEN
      WRITE(LU_OUTPUT,'(A,F8.4)') '     Conductivity (W/m/K)         ',ML%K_S
   ELSE
      NR = -NINT(ML%K_S)
      WRITE(LU_OUTPUT,'(A,F8.4)') '     Conductivity (W/m/K)         ',EVALUATE_RAMP(TMPA,0._EB,NR)
   ENDIF
   IF (ML%KAPPA_S<5.0E4_EB) THEN
      WRITE(LU_OUTPUT,'(A,F8.2)') '     Absorption coefficient (1/m) ',ML%KAPPA_S
   ENDIF
   IF (ML%PYROLYSIS_MODEL==PYROLYSIS_SOLID) THEN
   DO NR=1,ML%N_REACTIONS
      WRITE(LU_OUTPUT,'(A,I2)')   '     Reaction ', NR
      DO NN=1,N_MATL
         IF (ML%NU_RESIDUE(NN,NR) > 0._EB) WRITE(LU_OUTPUT,'(A,A,A,F6.3)') &
                               '        Residue: ',TRIM(MATL_NAME(NN)),', Yield: ',ML%NU_RESIDUE(NN,NR)
      ENDDO
      WRITE(LU_OUTPUT,'(A)')      '        Gaseous Yields:'
      DO NS = 1,N_TRACKED_SPECIES
      WRITE(LU_OUTPUT,'(A,A,A,F8.2)')'        ',SPECIES_MIXTURE(NS)%ID,': ',ML%NU_GAS(NS,NR)
      ENDDO
      WRITE(LU_OUTPUT,'(A,ES9.2)')'        A (1/s)    : ',ML%A(NR)
      WRITE(LU_OUTPUT,'(A,ES9.2)')'        E (J/mol): ',ML%E(NR)/1000.
      WRITE(LU_OUTPUT,'(A,ES9.2)')'        H_R (kJ/kg): ',ML%H_R(NR)/1000.
      WRITE(LU_OUTPUT,'(A,F8.2)') '        N_S        : ',ML%N_S(NR)
      IF (ML%N_O2(NR)>0._EB) THEN
      WRITE(LU_OUTPUT,'(A,F8.2)') '        N_O2       : ',ML%N_O2(NR)
      WRITE(LU_OUTPUT,'(A,F8.4)') '        Gas diffusion depth (m): ',ML%GAS_DIFFUSION_DEPTH(NR)
      ENDIF
      IF (ML%TMP_THR(NR)>0._EB) THEN
      WRITE(LU_OUTPUT,'(A,F8.2)') '        Threshold temperature (C): ',ML%TMP_THR(NR)-TMPM
      WRITE(LU_OUTPUT,'(A,F8.2)') '        N_T        : ',ML%N_T(NR)
      ENDIF
   ENDDO
   ENDIF
   IF (ML%PYROLYSIS_MODEL==PYROLYSIS_LIQUID) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Liquid evaporation reaction'
      WRITE(LU_OUTPUT,'(A)')      '        Gaseous Yields:'
      DO NS = 1,N_TRACKED_SPECIES
      WRITE(LU_OUTPUT,'(A,A,A,F8.2)')'        ',SPECIES_MIXTURE(NS)%ID,': ',ML%NU_GAS(NS,1)
      ENDDO
      WRITE(LU_OUTPUT,'(A,F8.2)') '        Boiling temperature (C): ',ML%TMP_BOIL-TMPM
      WRITE(LU_OUTPUT,'(A,ES9.2)')'        H_R (kJ/kg)            : ',ML%H_R(1)/1000.
   ENDIF
ENDDO MATL_LOOP

! Print out information about surface types

WRITE(LU_OUTPUT,'(//A,I2)')  ' Surface Conditions'

SURFLOOP: DO N=0,N_SURF

   SF => SURFACE(N)
   IF (N==DEFAULT_SURF_INDEX) THEN
      WRITE(LU_OUTPUT,'(/I4,1X,A,A)')  N,TRIM(SF%ID),' (DEFAULT)'
   ELSE
      WRITE(LU_OUTPUT,'(/I4,1X,A)')    N,TRIM(SF%ID)
   ENDIF
   IF (SF%FYI/='null') WRITE(LU_OUTPUT,'(5X,A)') TRIM(SF%FYI)
   IF (N==OPEN_SURF_INDEX) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Passive Vent to Atmosphere'
      CYCLE SURFLOOP
   ENDIF
   IF (N==MIRROR_SURF_INDEX) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Symmetry Plane'
      CYCLE SURFLOOP
   ENDIF

   THICK: IF (SF%THERMAL_BC_INDEX == THERMALLY_THICK) THEN
      WRITE(LU_OUTPUT,'(A)')      '     Material List'
      DO NN=1,SF%N_MATL
         WRITE(LU_OUTPUT,'(8X,I3,2X,A)') NN,TRIM(SF%MATL_NAME(NN))
      ENDDO
      DO NL=1,SF%N_LAYERS
         WRITE(LU_OUTPUT,'(A,I2)')      '     Layer ',NL
         WRITE(LU_OUTPUT,'(A,F8.5)')    '        Thickness   (m): ',SF%LAYER_THICKNESS(NL)
         WRITE(LU_OUTPUT,'(A,F8.2)')    '        Density (kg/m3): ',SF%LAYER_DENSITY(NL)
         DO NN=1,SF%N_LAYER_MATL(NL)
            WRITE(LU_OUTPUT,'(8X,A,A,F7.2)') TRIM(SF%LAYER_MATL_NAME(NL,NN)),', Mass fraction: ',SF%LAYER_MATL_FRAC(NL,NN)
         ENDDO
      ENDDO
      WRITE(LU_OUTPUT,'(A,F9.3,A)')     '     Total surface density ', SF%SURFACE_DENSITY, ' kg/m2'
      IF (SF%LAYER_DIVIDE<=SF%N_LAYERS) &
      WRITE(LU_OUTPUT,'(A,F5.2,A)')     '     Reaction products considered from the first ',SF%LAYER_DIVIDE, ' layers.'
      WRITE(LU_OUTPUT,'(A)')            '     Solid Phase Node, Layer, Coordinates(m):'
      DO I=0,SF%N_CELLS_INI
         WRITE(LU_OUTPUT,'(15X,I6, I7, F16.7)') I,SF%LAYER_INDEX(MAX(I,1)), SF%X_S(I)
      ENDDO
      IF (SF%GEOMETRY==SURF_CARTESIAN) THEN
         IF (SF%BACKING==VOID)      WRITE(LU_OUTPUT,'(A)') '     Backing to void'
         IF (SF%BACKING==INSULATED) WRITE(LU_OUTPUT,'(A)') '     Insulated Backing'
         IF (SF%BACKING==EXPOSED)   WRITE(LU_OUTPUT,'(A)') '     Exposed Backing'
      ENDIF
      IF (SF%GEOMETRY==SURF_CYLINDRICAL) WRITE(LU_OUTPUT,'(A)') '     Assumed cylindrical symmetry'
      IF (SF%GEOMETRY==SURF_SPHERICAL)   WRITE(LU_OUTPUT,'(A)') '     Assumed spherical symmetry'
   ENDIF THICK

   IF (SF%THERMAL_BC_INDEX==SPECIFIED_TEMPERATURE .AND. SF%TMP_FRONT>0._EB) &
                                  WRITE(LU_OUTPUT,'(A,F8.1)') '     Wall or Vent Temperature (C)', SF%TMP_FRONT - TMPM
   IF (ABS(SF%VEL)>TWO_EPSILON_EB)             WRITE(LU_OUTPUT,'(A,F8.3)')  '     Normal Velocity (m/s)      ', SF%VEL
   IF (ABS(SF%MASS_FLUX_TOTAL)>TWO_EPSILON_EB) WRITE(LU_OUTPUT,'(A,ES9.2)') '     Total Mass Flux (kg/m^2/s) ', SF%MASS_FLUX_TOTAL
   IF (ABS(SF%VOLUME_FLOW)>TWO_EPSILON_EB)     WRITE(LU_OUTPUT,'(A,ES9.2)') '     Volume Flow     (m^3/s)    ', SF%VOLUME_FLOW

   IF (SF%HRRPUA > 0._EB) WRITE(LU_OUTPUT,'(A,F12.1)') '     HRR Per Unit Area (kW/m2) ', SF%HRRPUA/1000._EB
   DO NN=1,N_TRACKED_SPECIES
      IF (SF%MASS_FRACTION(NN)>TWO_EPSILON_EB) WRITE(LU_OUTPUT,'(5X,A,A,8X,F6.3)') &
          TRIM(SPECIES_MIXTURE(NN)%ID),' Mass Fraction',SF%MASS_FRACTION(NN)
      IF (ABS(SF%MASS_FLUX(NN))>TWO_EPSILON_EB) WRITE(LU_OUTPUT,'(5X,A,A,2X,ES9.2)') &
          TRIM(SPECIES_MIXTURE(NN)%ID),' Mass Flux (kg/s/m2)',SF%MASS_FLUX(NN)
   ENDDO

   IF (ABS(SF%CONV_LENGTH - 1._EB)>SPACING(1._EB)) WRITE(LU_OUTPUT,'(A,ES9.2)') '     Convection length scale (m) ', SF%CONV_LENGTH

ENDDO SURFLOOP

! Print out information about all Devices

IF (N_PROP > 0) WRITE(LU_OUTPUT,'(//A,I2)')  ' Device Properties'

PROPERTY_LOOP: DO N=1,N_PROP
   PY => PROPERTY(N)
   WRITE(LU_OUTPUT,'(/I4,1X,A)')  N,TRIM(PY%ID)
   QUANTITY = PY%QUANTITY
   SELECT CASE(QUANTITY)
      CASE('NOZZLE FLOW RATE')
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Flow Rate (L/min)           ', PY%FLOW_RATE
         WRITE(LU_OUTPUT,'(A,A   )') '     Particle Class              ', TRIM(PY%PART_ID)
      CASE('SPRINKLER LINK TEMPERATURE')
         WRITE(LU_OUTPUT,'(A,F8.1)') '     RTI (m-s)^1/2               ', PY%RTI
         WRITE(LU_OUTPUT,'(A,F8.2)') '     C-Factor (m/s)^1/2          ', PY%C_FACTOR
         WRITE(LU_OUTPUT,'(A,F8.1)') '     Activation Temperature (C)  ', PY%ACTIVATION_TEMPERATURE
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Flow Rate (L/min)           ', PY%FLOW_RATE
         WRITE(LU_OUTPUT,'(A,F8.2)') '     K-Factor (L/min/bar**0.5)   ', PY%K_FACTOR
         WRITE(LU_OUTPUT,'(A,A   )') '     Particle Class              ', TRIM(PY%PART_ID)
      CASE('LINK TEMPERATURE')
         WRITE(LU_OUTPUT,'(A,F8.1)') '     RTI (m-s)^1/2               ', PY%RTI
         WRITE(LU_OUTPUT,'(A,F8.1)') '     Activation Temperature (C)  ', PY%ACTIVATION_TEMPERATURE
      CASE('CHAMBER OBSCURATION')
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Activation Obscuration (%/m)', PY%ACTIVATION_OBSCURATION
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Alpha_c or L                ', PY%ALPHA_C
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Beta_c                      ', PY%BETA_C
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Alpha_e                     ', PY%ALPHA_E
         WRITE(LU_OUTPUT,'(A,F8.2)') '     Beta_e                      ', PY%BETA_E
   END SELECT
   WRITE(LU_OUTPUT,'(A,A   )') '     Smokeview ID                ', TRIM(PY%SMOKEVIEW_ID(1))
ENDDO PROPERTY_LOOP

! Print out DEVICE locations and info

IF (N_DEVC>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Device Coordinates'
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%Y_INDEX>0) THEN
         WRITE(LU_OUTPUT,'(I6,A,3F9.2,A,A,A,A,A,A,A,A)') N,' Coords:',DV%X,DV%Y,DV%Z, &
            ', Make: ',TRIM(PROPERTY(DV%PROP_INDEX)%ID), ', ID: ',TRIM(DV%ID), ', Quantity: ',TRIM(DV%QUANTITY), &
            ', Species: ',TRIM(SPECIES(DV%Y_INDEX)%ID)
      ELSEIF (DV%Z_INDEX>=0) THEN
         WRITE(LU_OUTPUT,'(I6,A,3F9.2,A,A,A,A,A,A,A,A)') N,' Coords:',DV%X,DV%Y,DV%Z, &
            ', Make: ',TRIM(PROPERTY(DV%PROP_INDEX)%ID), ', ID: ',TRIM(DV%ID), ', Quantity: ',TRIM(DV%QUANTITY), &
            ', Species: ',TRIM(SPECIES_MIXTURE(DV%Z_INDEX)%ID)
      ELSEIF (DV%PART_CLASS_INDEX>0) THEN
         WRITE(LU_OUTPUT,'(I6,A,3F9.2,A,A,A,A,A,A,A,A)') N,' Coords:',DV%X,DV%Y,DV%Z, &
            ', Make: ',TRIM(PROPERTY(DV%PROP_INDEX)%ID), ', ID: ',TRIM(DV%ID), ', Quantity: ',TRIM(DV%QUANTITY), &
            ', Particle Class: ',TRIM(LAGRANGIAN_PARTICLE_CLASS(DV%PART_CLASS_INDEX)%ID)
      ELSE
         WRITE(LU_OUTPUT,'(I6,A,3F9.2,A,A,A,A,A,A)') N,' Coords:',DV%X,DV%Y,DV%Z, &
            ', Make: ',TRIM(PROPERTY(DV%PROP_INDEX)%ID), ', ID: ',TRIM(DV%ID), ', Quantity: ',TRIM(DV%QUANTITY)
      ENDIF
   ENDDO
ENDIF

! Write out PLOT3D Info

IF (DT_PL3D<T_END) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' PLOT3D Information'
   WRITE(LU_OUTPUT,'(A,F8.1/)')'   Sampling Interval (s)          ',DT_PL3D
   DO N=1,5
      IF (PLOT3D_Y_INDEX(N)>0) THEN
         WRITE(LU_OUTPUT,'(I4,A,A,A,A)') N,' Quantity: ',TRIM(PLOT3D_QUANTITY(N)), &
            ', Species: ',TRIM(SPECIES(PLOT3D_Y_INDEX(N))%ID)
      ELSEIF (PLOT3D_Z_INDEX(N)>=0) THEN
         WRITE(LU_OUTPUT,'(I4,A,A,A,A)') N,' Quantity: ',TRIM(PLOT3D_QUANTITY(N)), &
            ', Species: ',TRIM(SPECIES_MIXTURE(PLOT3D_Z_INDEX(N))%ID)
      ELSE
         WRITE(LU_OUTPUT,'(I4,A,A)') N,' Quantity: ',TRIM(PLOT3D_QUANTITY(N))
      ENDIF
   ENDDO
ENDIF

! Write out Isosurface File Info

IF (N_ISOF>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Isosurface File Information'
   WRITE(LU_OUTPUT,'(A,F8.3/)')'   Sampling Interval (s)          ',DT_ISOF
   DO N=1,N_ISOF
      IS => ISOSURFACE_FILE(N)
      WRITE(LU_OUTPUT,'(I4,A,A,A,10F8.3)')N,' Quantity: ',TRIM(IS%SMOKEVIEW_LABEL),', VALUE(s):',(IS%VALUE(I),I=1,IS%N_VALUES)
   ENDDO
ENDIF

! Write out Slice File Info

MESH_LOOP_4: DO NM=1,NMESHES
   M => MESHES(NM)
   IF (M%N_SLCF>0) THEN
      WRITE(LU_OUTPUT,'(//A,I5/)')   ' Slice File Information, Mesh ',NM
      WRITE(LU_OUTPUT,'(A,F8.3/)')'   Sampling Interval (s)          ',DT_SLCF
      DO N=1,M%N_SLCF
         SL=> M%SLICE(N)
         WRITE(LU_OUTPUT,'(I4,A,6I4,A,A)') N,' Nodes:',SL%I1,SL%I2,SL%J1,SL%J2,SL%K1,SL%K2,', Quantity: ',TRIM(SL%SMOKEVIEW_LABEL)
      ENDDO
   ENDIF
ENDDO MESH_LOOP_4

! Write out Boundary File info

IF (N_BNDF>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Boundary File Information'
   WRITE(LU_OUTPUT,'(A,F8.3/)')'   Sampling Interval (s)          ',DT_BNDF
   DO N=1,N_BNDF
      BF => BOUNDARY_FILE(N)
      WRITE(LU_OUTPUT,'(I4,A,A)') N,' Quantity: ',TRIM(BF%SMOKEVIEW_LABEL)
   ENDDO
ENDIF

! Write out Boundary Element File info

IF (N_BNDE>0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Boundary Element File Information'
   WRITE(LU_OUTPUT,'(A,F8.3/)')'   Sampling Interval (s)          ',DT_BNDE
   DO N=1,N_BNDE
      BE => BOUNDARY_ELEMENT_FILE(N)
      WRITE(LU_OUTPUT,'(I4,A,A)') N,' Quantity: ',TRIM(BE%SMOKEVIEW_LABEL)
   ENDDO
ENDIF

! Write out radiation info

WRITE_RADIATION: IF (RADIATION .AND. ALLOCATED(RSA)) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' Radiation Model Information'
   WRITE(LU_OUTPUT,'(A,I4)')   '   Number of control angles ', NUMBER_RADIATION_ANGLES
   WRITE(LU_OUTPUT,'(A,I4)')   '   Time step increment      ', TIME_STEP_INCREMENT
   WRITE(LU_OUTPUT,'(A,I4)')   '   Angle increment          ', ANGLE_INCREMENT
   IF (CYLINDRICAL .OR. .NOT.TWO_D) THEN
      WRITE(LU_OUTPUT,'(A)')   '   Theta band N_phi   Solid angle'
   ELSE
      WRITE(LU_OUTPUT,'(A)')   '   Phi band   N_theta Solid angle'
   ENDIF
   N = 1
   DO I=1,NRT
      WRITE(LU_OUTPUT,'(I6,A,I6,F10.3)') I,':   ',NRP(I),RSA(N)
      N = N + NRP(I)
   ENDDO
   IF (PATH_LENGTH>0._EB) THEN
      IF (NUMBER_SPECTRAL_BANDS>1) THEN
         WRITE(LU_OUTPUT,'(A,I4)')  '   Number of spectral bands is ', NUMBER_SPECTRAL_BANDS
      ELSE
         WRITE(LU_OUTPUT,'(A,I4)')  '   Using gray gas absorption.'
         WRITE(LU_OUTPUT,'(A,F6.3,A)')'   Mean beam length ',PATH_LENGTH,' m'
      ENDIF
   ELSE
      WRITE(LU_OUTPUT,'(A,F7.3,A)')'   Using constant absorption coefficient of ',KAPPA0,' 1/m'
   ENDIF
ENDIF WRITE_RADIATION

! Write out SCARC info

WRITE_SCARC: IF (TRIM(PRES_METHOD) == 'SCARC' .OR. TRIM(PRES_METHOD) == 'USCARC') THEN
   WRITE(LU_OUTPUT,'(//1X,A,A/)')     TRIM(PRES_METHOD), ' Information'
   WRITE(LU_OUTPUT,'(3X,A20,A12)') 'Discretization        ', TRIM(SCARC_DISCRETIZATION)
   WRITE(LU_OUTPUT,'(3X,A20,A12)') 'Global solver         ', TRIM(SCARC_METHOD)
   SELECT CASE(TRIM(SCARC_METHOD))
      CASE('KRYLOV')
         WRITE(LU_OUTPUT,'(3X,A20,A12)')   'Preconditioner        ', TRIM(SCARC_PRECON)
         WRITE(LU_OUTPUT,'(3X,A20,I12)')   'Max iterations        ', SCARC_KRYLOV_ITERATIONS
         WRITE(LU_OUTPUT,'(3X,A20,E12.2)') 'Stopping accuracy     ', SCARC_KRYLOV_ACCURACY
      CASE('MULTIGRID')
         WRITE(LU_OUTPUT,'(3X,A20,A12)') 'Smoother              ', TRIM(SCARC_SMOOTH)
         IF (TRIM(SCARC_MULTIGRID)=='ALGEBRAIC') &
            WRITE(LU_OUTPUT,'(3X,A20,A12)')   'Coarsening strategy   ', TRIM(SCARC_MULTIGRID_COARSENING)
         WRITE(LU_OUTPUT,'(3X,A20,A12)')   'Coarse grid solver    ', TRIM(SCARC_COARSE)
         WRITE(LU_OUTPUT,'(3X,A20,A12)')   'Cycle type            ', TRIM(SCARC_MULTIGRID_CYCLE)
         WRITE(LU_OUTPUT,'(3X,A20,I12)')   'Max iterations        ', SCARC_MULTIGRID_ITERATIONS
         WRITE(LU_OUTPUT,'(3X,A20,E12.2)') 'Stopping accuracy     ', SCARC_MULTIGRID_ACCURACY
         WRITE(LU_OUTPUT,'(3X,A20,A12)')   'Interpolation method  ', TRIM(SCARC_MULTIGRID_INTERPOL)
   END SELECT
ENDIF WRITE_SCARC

! Write out GLMAT info:

GLMAT_IF : IF(TRIM(PRES_METHOD)=='GLMAT') THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' GlMat Information'
#ifdef WITH_MKL
   WRITE(LU_OUTPUT,'(3X,A)') 'Global Pressure solver       : Intel MKL Cluster Sparse Solver'
#endif
ENDIF GLMAT_IF

WRITE(LU_OUTPUT,*)
WRITE(LU_OUTPUT,*)

END SUBROUTINE INITIALIZE_DIAGNOSTIC_FILE


SUBROUTINE DUMP_RESTART(T,DT,NM)

! Dump data to a file for possible restart

REAL(EB), INTENT(IN) :: T,DT
INTEGER :: NOM,N
INTEGER, INTENT(IN) :: NM
TYPE(OMESH_TYPE), POINTER :: M2=>NULL()
TYPE(DUCT_TYPE), POINTER :: DU=>NULL()
TYPE(DUCTNODE_TYPE), POINTER :: DN=>NULL()

IF (EVACUATION_ONLY(NM)) RETURN  ! No restart for evacuation

OPEN(LU_CORE(NM),FILE=FN_CORE(NM),FORM='UNFORMATTED',STATUS='REPLACE')

CALL POINT_TO_MESH(NM)

WRITE(LU_CORE(NM)) U
WRITE(LU_CORE(NM)) V
WRITE(LU_CORE(NM)) W
WRITE(LU_CORE(NM)) D
WRITE(LU_CORE(NM)) H
WRITE(LU_CORE(NM)) US
WRITE(LU_CORE(NM)) VS
WRITE(LU_CORE(NM)) WS
WRITE(LU_CORE(NM)) DS
WRITE(LU_CORE(NM)) HS
IF (N_LP_ARRAY_INDICES>0 .OR. N_REACTIONS>0 .OR. ANY(SPECIES_MIXTURE%DEPOSITING)) WRITE(LU_CORE(NM)) D_SOURCE
IF (N_LP_ARRAY_INDICES>0 .OR. N_REACTIONS>0 .OR. ANY(SPECIES_MIXTURE%DEPOSITING)) WRITE(LU_CORE(NM)) M_DOT_PPP
WRITE(LU_CORE(NM)) RHO
WRITE(LU_CORE(NM)) TMP
WRITE(LU_CORE(NM)) Q
WRITE(LU_CORE(NM)) QR
WRITE(LU_CORE(NM)) CHI_R
WRITE(LU_CORE(NM)) UII
IF (RADIATION) WRITE(LU_CORE(NM)) UIID
WRITE(LU_CORE(NM)) SOLID
WRITE(LU_CORE(NM)) EDGE_INDEX
WRITE(LU_CORE(NM)) IJKE
WRITE(LU_CORE(NM)) OME_E
WRITE(LU_CORE(NM)) TAU_E
WRITE(LU_CORE(NM)) UVW_SAVE
WRITE(LU_CORE(NM)) U_GHOST
WRITE(LU_CORE(NM)) V_GHOST
WRITE(LU_CORE(NM)) W_GHOST
WRITE(LU_CORE(NM)) DS_CORR

WRITE(LU_CORE(NM)) ZZ
WRITE(LU_CORE(NM)) DEL_RHO_D_DEL_Z

DO N=1,N_INIT
   IN => INITIALIZATION(N)
   WRITE(LU_CORE(NM)) IN%ALREADY_INSERTED(NM)
   WRITE(LU_CORE(NM)) IN%PARTICLE_INSERT_CLOCK(NM)
ENDDO

DO N=1,N_SURF
   SF => SURFACE(N)
   WRITE(LU_CORE(NM)) SF%PARTICLE_INSERT_CLOCK(NM)
ENDDO

DO N=1,N_OBST
   OB => OBSTRUCTION(N)
   WRITE(LU_CORE(NM)) OB%MASS
   WRITE(LU_CORE(NM)) OB%HIDDEN
ENDDO

WRITE(LU_CORE(NM)) T,ICYC,PART_CLOCK(NM),RESTART_CLOCK,SLCF_CLOCK(NM),RADF_CLOCK(NM), &
             PL3D_CLOCK(NM),BNDF_CLOCK(NM),BNDC_CLOCK,BNDE_CLOCK,GEOC_CLOCK,GEOM_CLOCK,DEVC_CLOCK,HRR_CLOCK,MINT_CLOCK, &
             ISOF_CLOCK(NM),BC_CLOCK,WALL_COUNTER,DT, &
             PBAR,D_PBAR_DT,N_EDGES,RAD_CALL_COUNTER,ANGLE_INC_COUNTER,T_LAST_DUMP_HRR,T_LAST_DUMP_MASS,&
             RTE_SOURCE_CORRECTION_FACTOR,RAD_Q_SUM,KFST4_SUM,SPECIFIC_ENTHALPY_SUM(NM),&
             BC_CLOCK_HT3D,WALL_COUNTER_HT3D
DO N=1,N_DEVC
   DV => DEVICE(N)
   WRITE(LU_CORE(NM)) DV%T,DV%T_CHANGE,DV%TMP_L,DV%Y_C,DV%CURRENT_STATE,DV%PRIOR_STATE,&
                      DV%LP_TAG,DV%PART_CLASS_INDEX,DV%RMS_VALUE,DV%RMS_VALUE2,DV%COV_VALUE,DV%AVERAGE_VALUE,&
                      DV%AVERAGE_VALUE2,DV%VALUE,DV%SMOOTHED_VALUE,DV%TIME_INTERVAL
   IF (DV%QUANTITY=='CHAMBER OBSCURATION') THEN
      WRITE(LU_CORE(NM)) UBOUND(DV%T_E,1)
      WRITE(LU_CORE(NM)) DV%N_T_E,DV%T_E,DV%Y_E
   ENDIF
   IF (DV%QUANTITY=='ASPIRATION') THEN
      WRITE(LU_CORE(NM)) DV%YY_SOOT,DV%TIME_ARRAY
   ENDIF
   IF (ALLOCATED(DV%TIME_MIN_VALUE)) WRITE(LU_CORE(NM)) DV%TIME_MIN_VALUE(1:DV%N_INTERVALS)
   IF (ALLOCATED(DV%TIME_MAX_VALUE)) WRITE(LU_CORE(NM)) DV%TIME_MAX_VALUE(1:DV%N_INTERVALS)
ENDDO
DO N=1,N_CTRL
   WRITE(LU_CORE(NM)) CONTROL(N)%T_CHANGE,CONTROL(N)%CURRENT_STATE,CONTROL(N)%PRIOR_STATE
ENDDO

DO N=0,N_SURF
   WRITE(LU_CORE(NM)) WALL_STORAGE(N)%N_STORAGE_SLOTS
   IF (WALL_STORAGE(N)%N_STORAGE_SLOTS>0) THEN
      WRITE(LU_CORE(NM)) WALL_STORAGE(N)%REALS
      WRITE(LU_CORE(NM)) WALL_STORAGE(N)%INTEGERS
      WRITE(LU_CORE(NM)) WALL_STORAGE(N)%LOGICALS
   ENDIF
ENDDO

WRITE(LU_CORE(NM)) NLP,NLPDIM,PARTICLE_TAG
DO N=1,N_LAGRANGIAN_CLASSES
   WRITE(LU_CORE(NM)) PARTICLE_STORAGE(N)%N_STORAGE_SLOTS
   IF (PARTICLE_STORAGE(N)%N_STORAGE_SLOTS>0) THEN
      WRITE(LU_CORE(NM)) PARTICLE_STORAGE(N)%REALS
      WRITE(LU_CORE(NM)) PARTICLE_STORAGE(N)%INTEGERS
      WRITE(LU_CORE(NM)) PARTICLE_STORAGE(N)%LOGICALS
   ENDIF
ENDDO

OTHER_MESH_LOOP: DO NOM=1,NMESHES
   M2=>MESHES(NM)%OMESH(NOM)
   IF (M2%NIC_R==0) CYCLE OTHER_MESH_LOOP
   IF (EVACUATION_ONLY(NOM)) CYCLE OTHER_MESH_LOOP
   WRITE(LU_CORE(NM)) M2%RHO,M2%RHOS,M2%U,M2%V,M2%W,M2%H
   WRITE(LU_CORE(NM)) M2%ZZ,M2%ZZS
ENDDO OTHER_MESH_LOOP

IF (HVAC_SOLVE .AND. NM==1) THEN
   DO N=1,N_DUCTS
      DU=>DUCT(N)
      WRITE(LU_CORE(NM)) DU%CP_D,DU%RHO_D,DU%TMP_D,DU%VEL,DU%RSUM_D,DU%ZZ,DU%DP_FAN,DU%FAN_ON_TIME,DU%COIL_ON_TIME
      IF (HVAC_MASS_TRANSPORT) WRITE(LU_CORE(NM)) DU%RHO_C,DU%TMP_C,DU%ZZ_C
   ENDDO
   DO N=1,N_DUCTNODES
      DN=>DUCTNODE(N)
      WRITE(LU_CORE(NM)) DN%ZZ,DN%ZZ_V,DN%P,DN%P_OLD,DN%TMP,DN%RSUM,DN%CP
      IF (DN%FILTER_INDEX>0) WRITE(LU_CORE(NM)) DN%FILTER_LOADING,DN%FILTER_LOSS
   ENDDO
ENDIF

CLOSE(LU_CORE(NM))

END SUBROUTINE DUMP_RESTART


SUBROUTINE READ_RESTART(T,DT,NM)

! Read data from a previous calculation

USE COMP_FUNCTIONS, ONLY: SHUTDOWN
USE MEMORY_FUNCTIONS, ONLY: REALLOCATE,ALLOCATE_STORAGE
REAL(EB), INTENT(OUT) :: T,DT
INTEGER :: NOM,N,N_T_E_MAX,NS
INTEGER, INTENT(IN) :: NM
LOGICAL :: EX
CHARACTER(MESSAGE_LENGTH) :: MESSAGE
TYPE(OMESH_TYPE), POINTER :: M2=>NULL()
TYPE(LAGRANGIAN_PARTICLE_CLASS_TYPE), POINTER :: LPC
TYPE(DUCT_TYPE), POINTER :: DU=>NULL()
TYPE(DUCTNODE_TYPE), POINTER :: DN=>NULL()

IF (EVACUATION_ONLY(NM)) RETURN ! No restart for evacuation
INQUIRE(FILE=FN_RESTART(NM),EXIST=EX)
IF (.NOT.EX) THEN
   WRITE(MESSAGE,'(A,A,A)') "ERROR: The file, ",TRIM(FN_RESTART(NM)),", does not exist in the current directory"
   CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.) ; RETURN
ENDIF

OPEN(LU_RESTART(NM),FILE=FN_RESTART(NM),FORM='UNFORMATTED',STATUS='OLD')

CALL POINT_TO_MESH(NM)

READ(LU_RESTART(NM))  U
READ(LU_RESTART(NM))  V
READ(LU_RESTART(NM))  W
READ(LU_RESTART(NM))  D
READ(LU_RESTART(NM))  H
READ(LU_RESTART(NM))  US
READ(LU_RESTART(NM))  VS
READ(LU_RESTART(NM))  WS
READ(LU_RESTART(NM))  DS
READ(LU_RESTART(NM))  HS
IF (N_LP_ARRAY_INDICES>0 .OR. N_REACTIONS>0 .OR. ANY(SPECIES_MIXTURE%DEPOSITING)) READ(LU_RESTART(NM)) D_SOURCE
IF (N_LP_ARRAY_INDICES>0 .OR. N_REACTIONS>0 .OR. ANY(SPECIES_MIXTURE%DEPOSITING)) READ(LU_RESTART(NM)) M_DOT_PPP
READ(LU_RESTART(NM))  RHO
READ(LU_RESTART(NM))  TMP
READ(LU_RESTART(NM))  Q
READ(LU_RESTART(NM))  QR
READ(LU_RESTART(NM))  CHI_R
READ(LU_RESTART(NM))  UII
IF (RADIATION) READ(LU_RESTART(NM)) UIID
READ(LU_RESTART(NM))  SOLID
READ(LU_RESTART(NM))  EDGE_INDEX
READ(LU_RESTART(NM))  IJKE
READ(LU_RESTART(NM))  OME_E
READ(LU_RESTART(NM))  TAU_E
READ(LU_RESTART(NM))  UVW_SAVE
READ(LU_RESTART(NM))  U_GHOST
READ(LU_RESTART(NM))  V_GHOST
READ(LU_RESTART(NM))  W_GHOST
READ(LU_RESTART(NM))  DS_CORR

READ(LU_RESTART(NM))  ZZ
READ(LU_RESTART(NM))  DEL_RHO_D_DEL_Z

DO N=1,N_INIT
   IN => INITIALIZATION(N)
   READ(LU_RESTART(NM)) IN%ALREADY_INSERTED(NM)
   READ(LU_RESTART(NM)) IN%PARTICLE_INSERT_CLOCK(NM)
ENDDO

DO N=1,N_SURF
   SF => SURFACE(N)
   READ(LU_RESTART(NM)) SF%PARTICLE_INSERT_CLOCK(NM)
ENDDO

DO N=1,N_OBST
   OB => OBSTRUCTION(N)
   READ(LU_RESTART(NM)) OB%MASS
   READ(LU_RESTART(NM)) OB%HIDDEN
ENDDO

READ(LU_RESTART(NM)) T,ICYC,PART_CLOCK(NM),RESTART_CLOCK,SLCF_CLOCK(NM),RADF_CLOCK(NM), &
             PL3D_CLOCK(NM),BNDF_CLOCK(NM),BNDC_CLOCK,BNDE_CLOCK,GEOC_CLOCK,GEOM_CLOCK,DEVC_CLOCK,HRR_CLOCK,MINT_CLOCK, &
             ISOF_CLOCK(NM),BC_CLOCK,WALL_COUNTER,DT, &
             PBAR,D_PBAR_DT,N_EDGES,RAD_CALL_COUNTER,ANGLE_INC_COUNTER,T_LAST_DUMP_HRR,T_LAST_DUMP_MASS, &
             RTE_SOURCE_CORRECTION_FACTOR,RAD_Q_SUM,KFST4_SUM,SPECIFIC_ENTHALPY_SUM(NM),&
             BC_CLOCK_HT3D,WALL_COUNTER_HT3D
ICYC_RESTART = ICYC
DO N=1,N_DEVC
   DV => DEVICE(N)
   READ(LU_RESTART(NM)) DV%T,DV%T_CHANGE,DV%TMP_L,DV%Y_C,DV%CURRENT_STATE,DV%PRIOR_STATE,&
                        DV%LP_TAG,DV%PART_CLASS_INDEX,DV%RMS_VALUE,DV%RMS_VALUE2,DV%COV_VALUE,DV%AVERAGE_VALUE,&
                        DV%AVERAGE_VALUE2,DV%VALUE,DV%SMOOTHED_VALUE,DV%TIME_INTERVAL
   IF (DV%QUANTITY=='CHAMBER OBSCURATION') THEN
      READ(LU_RESTART(NM)) N_T_E_MAX
      DV%T_E => REALLOCATE(DV%T_E,-1,N_T_E_MAX)
      DV%Y_E => REALLOCATE(DV%Y_E,-1,N_T_E_MAX)
      READ(LU_RESTART(NM)) DV%N_T_E,DV%T_E,DV%Y_E
   ENDIF
   IF (DV%QUANTITY=='ASPIRATION') THEN
      READ(LU_RESTART(NM)) DV%YY_SOOT,DV%TIME_ARRAY
   ENDIF
   IF (ALLOCATED(DV%TIME_MIN_VALUE)) READ(LU_RESTART(NM)) DV%TIME_MIN_VALUE(1:DV%N_INTERVALS)
   IF (ALLOCATED(DV%TIME_MAX_VALUE)) READ(LU_RESTART(NM)) DV%TIME_MAX_VALUE(1:DV%N_INTERVALS)
ENDDO

DO N=1,N_CTRL
   READ(LU_RESTART(NM)) CONTROL(N)%T_CHANGE,CONTROL(N)%CURRENT_STATE,CONTROL(N)%PRIOR_STATE
ENDDO

DO N=0,N_SURF
   READ(LU_RESTART(NM)) WALL_STORAGE(N)%N_STORAGE_SLOTS
   IF (WALL_STORAGE(N)%N_STORAGE_SLOTS>0) THEN
      READ(LU_RESTART(NM)) WALL_STORAGE(N)%REALS
      READ(LU_RESTART(NM)) WALL_STORAGE(N)%INTEGERS
      READ(LU_RESTART(NM)) WALL_STORAGE(N)%LOGICALS
   ENDIF
ENDDO

READ(LU_RESTART(NM)) NLP,NLPDIM,PARTICLE_TAG
IF (NLPDIM>0) THEN
   IF (ALLOCATED(MESHES(NM)%LAGRANGIAN_PARTICLE)) DEALLOCATE(MESHES(NM)%LAGRANGIAN_PARTICLE)
   ALLOCATE(MESHES(NM)%LAGRANGIAN_PARTICLE(NLPDIM))
ENDIF
DO N=1,N_LAGRANGIAN_CLASSES
   LPC => LAGRANGIAN_PARTICLE_CLASS(N)
   READ(LU_RESTART(NM)) PARTICLE_STORAGE(N)%N_STORAGE_SLOTS
   IF (PARTICLE_STORAGE(N)%N_STORAGE_SLOTS>0) THEN
      ALLOCATE(MESHES(NM)%PARTICLE_STORAGE(N)%REALS(LPC%N_STORAGE_REALS,PARTICLE_STORAGE(N)%N_STORAGE_SLOTS))
      ALLOCATE(MESHES(NM)%PARTICLE_STORAGE(N)%INTEGERS(LPC%N_STORAGE_INTEGERS,PARTICLE_STORAGE(N)%N_STORAGE_SLOTS))
      ALLOCATE(MESHES(NM)%PARTICLE_STORAGE(N)%LOGICALS(LPC%N_STORAGE_LOGICALS,PARTICLE_STORAGE(N)%N_STORAGE_SLOTS))
      READ(LU_RESTART(NM)) MESHES(NM)%PARTICLE_STORAGE(N)%REALS
      READ(LU_RESTART(NM)) MESHES(NM)%PARTICLE_STORAGE(N)%INTEGERS
      READ(LU_RESTART(NM)) MESHES(NM)%PARTICLE_STORAGE(N)%LOGICALS
      DO NS=1,PARTICLE_STORAGE(N)%N_STORAGE_SLOTS
         IF (MESHES(NM)%PARTICLE_STORAGE(N)%INTEGERS(1,NS)>0) THEN
            CALL ALLOCATE_STORAGE(NM,LAGRANGIAN_PARTICLE_CLASS(N)%SURF_INDEX,LPC_INDEX=N, &
                                  LP_INDEX=MESHES(NM)%PARTICLE_STORAGE(N)%INTEGERS(2,NS),&
                                  TAG=MESHES(NM)%PARTICLE_STORAGE(N)%INTEGERS(1,NS), &
                                  NEW_TAG=.FALSE.)
         ENDIF
      ENDDO
   ENDIF
ENDDO

OTHER_MESH_LOOP: DO NOM=1,NMESHES
   M2=>MESHES(NM)%OMESH(NOM)
   IF (M2%NIC_R==0) CYCLE OTHER_MESH_LOOP
   IF (EVACUATION_ONLY(NOM)) CYCLE OTHER_MESH_LOOP
   READ(LU_RESTART(NM)) M2%RHO,M2%RHOS,M2%U,M2%V,M2%W,M2%H
   READ(LU_RESTART(NM)) M2%ZZ,M2%ZZS

ENDDO OTHER_MESH_LOOP

IF (HVAC_SOLVE .AND. NM==1) THEN
   DO N=1,N_DUCTS
      DU=>DUCT(N)
      READ(LU_RESTART(NM)) DU%CP_D,DU%RHO_D,DU%TMP_D,DU%VEL,DU%RSUM_D,DU%ZZ,DU%DP_FAN,DU%FAN_ON_TIME,DU%COIL_ON_TIME
      IF (HVAC_MASS_TRANSPORT) READ(LU_RESTART(NM)) DU%RHO_C,DU%TMP_C,DU%ZZ_C
   ENDDO
   DO N=1,N_DUCTNODES
      DN=>DUCTNODE(N)
      READ(LU_RESTART(NM)) DN%ZZ,DN%ZZ_V,DN%P,DN%P_OLD,DN%TMP,DN%RSUM,DN%CP
      IF (DN%FILTER_INDEX>0) READ(LU_RESTART(NM)) DN%FILTER_LOADING,DN%FILTER_LOSS
   ENDDO
ENDIF


CLOSE(LU_RESTART(NM))

END SUBROUTINE READ_RESTART


SUBROUTINE WRITE_DIAGNOSTICS(T,DT)

! Write cycle number, elapsed time since the last call,
! current time for the physical system, and current number of
! particles in the system.

USE SCRC, ONLY: SCARC_CAPPA, SCARC_ITERATIONS, SCARC_RESIDUAL
REAL(EB), INTENT(IN) :: T,DT
INTEGER :: NM,II,JJ,KK
CHARACTER(80) :: SIMPLE_OUTPUT,SIMPLE_OUTPUT_ERR
CHARACTER(LABEL_LENGTH) :: DATE
REAL(EB) :: TNOW

TNOW = CURRENT_TIME()

IF (ICYC==1) WRITE(LU_OUTPUT,100)

IF (T<=0.0001) THEN
   WRITE(SIMPLE_OUTPUT,'(1X,A,I7,A,F10.5,A,F8.5,A)')  'Time Step:',ICYC,', Simulation Time:',T,' s, Step Size:',DT,' s'
ELSEIF (T>0.0001 .AND. T <=0.001) THEN
   WRITE(SIMPLE_OUTPUT,'(1X,A,I7,A,F10.4,A,F8.5,A)')  'Time Step:',ICYC,', Simulation Time:',T,' s, Step Size:',DT,' s'
ELSEIF (T>0.001 .AND. T<=0.01) THEN
   WRITE(SIMPLE_OUTPUT,'(1X,A,I7,A,F10.3,A,F8.5,A)')  'Time Step:',ICYC,', Simulation Time:',T,' s, Step Size:',DT,' s'
ELSE
   WRITE(SIMPLE_OUTPUT,'(1X,A,I7,A,F10.2,A,F8.5,A)')  'Time Step:',ICYC,', Simulation Time:',T,' s, Step Size:',DT,' s'
ENDIF

! Simple output without DT for .err file

IF (T<=0.0001) THEN
   WRITE(SIMPLE_OUTPUT_ERR,'(1X,A,I7,A,F10.5,A)')  'Time Step:',ICYC,', Simulation Time:',T,' s'
ELSEIF (T>0.0001 .AND. T <=0.001) THEN
   WRITE(SIMPLE_OUTPUT_ERR,'(1X,A,I7,A,F10.4,A)')  'Time Step:',ICYC,', Simulation Time:',T,' s'
ELSEIF (T>0.001 .AND. T<=0.01) THEN
   WRITE(SIMPLE_OUTPUT_ERR,'(1X,A,I7,A,F10.3,A)')  'Time Step:',ICYC,', Simulation Time:',T,' s'
ELSE
   WRITE(SIMPLE_OUTPUT_ERR,'(1X,A,I7,A,F10.2,A)')  'Time Step:',ICYC,', Simulation Time:',T,' s'
ENDIF

! Write simple output string to .err file

WRITE(LU_ERR,'(A)') TRIM(SIMPLE_OUTPUT_ERR)

! Write simple output string to .out file if the diagnostics are suppressed.

IF (SUPPRESS_DIAGNOSTICS) THEN
   WRITE(LU_OUTPUT,'(A)') TRIM(SIMPLE_OUTPUT)
   RETURN
ENDIF

! Detailed diagnostics

CALL GET_DATE(DATE)
WRITE(LU_OUTPUT,'(7X,A,I7,3X,A)') 'Time Step ',ICYC,TRIM(DATE)
IF (T<=0.0001) THEN
   WRITE(LU_OUTPUT,150) DT,T
ELSEIF (T>0.0001 .AND. T <=0.001) THEN
   WRITE(LU_OUTPUT,151) DT,T
ELSEIF (T>0.001 .AND. T <=0.01) THEN
   WRITE(LU_OUTPUT,152) DT,T
ELSE
   WRITE(LU_OUTPUT,153) DT,T
ENDIF
IF (ITERATE_PRESSURE) THEN
   NM = MAXLOC(VELOCITY_ERROR_MAX,1)
   II = VELOCITY_ERROR_MAX_LOC(1,NM)
   JJ = VELOCITY_ERROR_MAX_LOC(2,NM)
   KK = VELOCITY_ERROR_MAX_LOC(3,NM)
   WRITE(LU_OUTPUT,'(7X,A,I6)') 'Pressure Iterations: ',PRESSURE_ITERATIONS
   WRITE(LU_OUTPUT,'(7X,A,E9.2,A,I3,A,3I4,A)') 'Maximum Velocity Error: ',MAXVAL(VELOCITY_ERROR_MAX), &
                                               ' on Mesh ',NM,' at (',II,JJ,KK,')'
   NM = MAXLOC(PRESSURE_ERROR_MAX,1)
   II = PRESSURE_ERROR_MAX_LOC(1,NM)
   JJ = PRESSURE_ERROR_MAX_LOC(2,NM)
   KK = PRESSURE_ERROR_MAX_LOC(3,NM)
   WRITE(LU_OUTPUT,'(7X,A,E9.2,A,I3,A,3I4,A)') 'Maximum Pressure Error: ',MAXVAL(PRESSURE_ERROR_MAX), &
                                               ' on Mesh ',NM,' at (',II,JJ,KK,')'
ENDIF
IF (TRIM(PRES_METHOD) == 'SCARC' .OR. TRIM(PRES_METHOD) == 'USCARC') THEN
   WRITE(LU_OUTPUT,'(7X,A,i6,A,e9.2,A,e9.2)') 'ScaRC: iterations', SCARC_ITERATIONS, &
                                              ', residual ',SCARC_RESIDUAL,&
                                              ', convergence rate  ',SCARC_CAPPA
ENDIF
WRITE(LU_OUTPUT,'(7X,A)') '---------------------------------------------------------------'

DO NM=1,NMESHES
   IF (EVACUATION_ONLY(NM)) CYCLE
   IF (NMESHES>1) WRITE(LU_OUTPUT,'(6X,A,I4)') ' Mesh ',NM
   M => MESHES(NM)
   WRITE(LU_OUTPUT,154) M%CFL,M%ICFL,M%JCFL,M%KCFL, M%DIVMX,M%IMX,M%JMX,M%KMX, M%DIVMN,M%IMN,M%JMN,M%KMN
   IF (ABS(M%RESMAX)>1.E-8_EB)  WRITE(LU_OUTPUT,133) M%RESMAX,M%IRM,M%JRM,M%KRM
   IF (ABS(M%POIS_PTB)>1.E-10_EB)  WRITE(LU_OUTPUT,'(A,E9.2)') '       Poisson Pert. : ',M%POIS_PTB
   IF (CHECK_POISSON) WRITE(LU_OUTPUT,'(A,E9.2)') '       Poisson Error : ',M%POIS_ERR
   IF (EXTERNAL_BOUNDARY_CORRECTION) THEN
      IF (ABS(M%LAPLACE_PTB)>1.E-10_EB)  WRITE(LU_OUTPUT,'(A,E9.2)') '       Laplace Pert. : ',M%LAPLACE_PTB
      IF (CHECK_POISSON) WRITE(LU_OUTPUT,'(A,E9.2)') '       Laplace Error : ',M%LAPLACE_ERR
   ENDIF
   IF (SIM_MODE==DNS_MODE .OR. CHECK_VN) WRITE(LU_OUTPUT,230) M%VN,M%I_VN,M%J_VN,M%K_VN
   IF (M%NLP>0) WRITE(LU_OUTPUT,141) M%NLP
   IF (ABS(Q_DOT(1,NM))>1._EB) WRITE(LU_OUTPUT,119) Q_DOT(1,NM)/1000._EB
   IF (ABS(Q_DOT(2,NM))>1._EB) WRITE(LU_OUTPUT,120) Q_DOT(2,NM)/1000._EB
ENDDO

WRITE(LU_OUTPUT,*)

100 FORMAT(/' Run Time Diagnostics'/)
150 FORMAT(6X,' Step Size: ',E12.3,' s, Total Time: ',F10.5,' s')
151 FORMAT(6X,' Step Size: ',E12.3,' s, Total Time: ',F10.4,' s')
152 FORMAT(6X,' Step Size: ',E12.3,' s, Total Time: ',F10.3,' s')
153 FORMAT(6X,' Step Size: ',E12.3,' s, Total Time: ',F10.2,' s')
154 FORMAT(6X,' Max CFL number: ',E9.2,' at (',I4,',',I4,',',I4,')'/ &
           6X,' Max divergence: ',E9.2,' at (',I4,',',I4,',',I4,')'/ &
           6X,' Min divergence: ',E9.2,' at (',I4,',',I4,',',I4,')')
133 FORMAT(6X,' Max div. error: ',E9.2,' at (',I4,',',I4,',',I4,')')
230 FORMAT(6X,' Max VN number:  ',E9.2,' at (',I4,',',I4,',',I4,')')
119 FORMAT(6X,' Total Heat Release Rate:      ',F13.3,' kW')
120 FORMAT(6X,' Radiation Loss to Boundaries: ',F13.3,' kW')
141 FORMAT(6X,' No. of Lagrangian Particles:  ',I12)

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW

END SUBROUTINE WRITE_DIAGNOSTICS


SUBROUTINE DUMP_PART(T,NM)

! Dump Lagrangian particle data to CHID.prt5

USE MEMORY_FUNCTIONS, ONLY: CHKMEMERR

INTEGER, INTENT(IN)  :: NM
REAL(EB), INTENT(IN) :: T
REAL(EB) :: STIME
INTEGER  :: NPP,NPLIM,I,N,NN,IZERO
REAL(EB), ALLOCATABLE, DIMENSION(:) :: XP,YP,ZP
REAL(EB), ALLOCATABLE, DIMENSION(:,:) :: QP
INTEGER, ALLOCATABLE, DIMENSION(:) :: TA

IF (EVACUATION_ONLY(NM)) RETURN
CALL POINT_TO_MESH(NM)

! Write the current time to the prt5 file, then start looping through the particle classes

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR

IF (EB_PART_FILE) THEN
   WRITE(LU_PART(NM)) STIME
ELSE
   WRITE(LU_PART(NM)) REAL(STIME,FB)
ENDIF

LAGRANGIAN_PARTICLE_CLASS_LOOP: DO N=1,N_LAGRANGIAN_CLASSES

   LPC => LAGRANGIAN_PARTICLE_CLASS(N)

   ! Count the number of particles to dump out

   NPLIM = 0
   DO I=1,NLP
      LP=>LAGRANGIAN_PARTICLE(I)
      IF (LP%SHOW .AND. LP%CLASS_INDEX==N) NPLIM = NPLIM + 1
   ENDDO

   ! Allocate some temporary 4 byte arrays just to hold the data that is to be dumped to the file

   ALLOCATE(TA(NPLIM),STAT=IZERO)                  ; CALL ChkMemErr('DUMP','TA',IZERO)
   ALLOCATE(XP(NPLIM),STAT=IZERO)                  ; CALL ChkMemErr('DUMP','XP',IZERO)
   ALLOCATE(YP(NPLIM),STAT=IZERO)                  ; CALL ChkMemErr('DUMP','YP',IZERO)
   ALLOCATE(ZP(NPLIM),STAT=IZERO)                  ; CALL ChkMemErr('DUMP','ZP',IZERO)
   ALLOCATE(QP(NPLIM,LPC%N_QUANTITIES),STAT=IZERO) ; CALL ChkMemErr('DUMP','QP',IZERO)

   ! Load particle data into single precision arrays

   NPP = 0
   LOAD_LOOP: DO I=1,NLP
      LP=>LAGRANGIAN_PARTICLE(I)
      IF (.NOT.LP%SHOW .OR. LP%CLASS_INDEX/=N) CYCLE LOAD_LOOP
      NPP = NPP + 1
      IF (NPP > NPLIM) EXIT LOAD_LOOP
      TA(NPP) = LP%TAG
      XP(NPP) = LP%X
      YP(NPP) = LP%Y
      ZP(NPP) = LP%Z
      DO NN=1,LPC%N_QUANTITIES
         SELECT CASE(LPC%QUANTITIES_INDEX(NN))
            CASE(434)  ! PARTICLE DIAMETER
               QP(NPP,NN) = 2.E6*SUM(LP%ONE_D%LAYER_THICKNESS)
            CASE(435)  ! PARTICLE VELOCITY
               QP(NPP,NN) = SQRT(LP%U**2+LP%V**2+LP%W**2)
            CASE(436)  ! PARTICLE PHASE
               QP(NPP,NN) = LP%ONE_D%IOR
            CASE(437)  ! PARTICLE TEMPERATURE
               QP(NPP,NN) = LP%ONE_D%TMP_F - TMPM
            CASE(438)  ! PARTICLE MASS
               QP(NPP,NN) = LP%MASS
            CASE(439)  ! PARTICLE AGE
               QP(NPP,NN) = T-LP%T_INSERT
            CASE(440)  ! PARTICLE WEIGHTING FACTOR
               QP(NPP,NN) = LP%PWT
            CASE(441)  ! PARTICLE X
               QP(NPP,NN) = LP%X
            CASE(442)  ! PARTICLE Y
               QP(NPP,NN) = LP%Y
            CASE(443)  ! PARTICLE Z
               QP(NPP,NN) = LP%Z
            CASE(444)  ! PARTICLE U
               QP(NPP,NN) = LP%U
            CASE(445)  ! PARTICLE V
               QP(NPP,NN) = LP%V
            CASE(446)  ! PARTICLE W
               QP(NPP,NN) = LP%W
            CASE(:-1)  ! Any solid phase quantity (assume Z_INDEX=-1 for now)
               QP(NPP,NN) = SOLID_PHASE_OUTPUT(NM,ABS(LPC%QUANTITIES_INDEX(NN)),LPC%QUANTITIES_Y_INDEX(NN),&
                                               LPC%QUANTITIES_Z_INDEX(NN),N,OPT_LP_INDEX=I)
         END SELECT
      ENDDO
   ENDDO LOAD_LOOP

   ! Dump particle data into the .prt5 file

   WRITE(LU_PART(NM)) NPLIM
   IF (EB_PART_FILE)      WRITE(LU_PART(NM)) (XP(I),I=1,NPLIM),(YP(I),I=1,NPLIM),(ZP(I),I=1,NPLIM)
   IF (.NOT.EB_PART_FILE) WRITE(LU_PART(NM)) (REAL(XP(I),FB),I=1,NPLIM),(REAL(YP(I),FB),I=1,NPLIM),(REAL(ZP(I),FB),I=1,NPLIM)
   WRITE(LU_PART(NM)) (TA(I),I=1,NPLIM)
   IF (     EB_PART_FILE .AND. LPC%N_QUANTITIES > 0) WRITE(LU_PART(NM)) ((QP(I,NN),I=1,NPLIM),NN=1,LPC%N_QUANTITIES)
   IF (.NOT.EB_PART_FILE .AND. LPC%N_QUANTITIES > 0) WRITE(LU_PART(NM)) ((REAL(QP(I,NN),FB),I=1,NPLIM),NN=1,LPC%N_QUANTITIES)

   DEALLOCATE(XP)
   DEALLOCATE(YP)
   DEALLOCATE(ZP)
   DEALLOCATE(QP)
   DEALLOCATE(TA)

ENDDO LAGRANGIAN_PARTICLE_CLASS_LOOP

END SUBROUTINE DUMP_PART



SUBROUTINE DUMP_ISOF(T,DT,NM)

! Write out isosurface data to file(s).

REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: NM
REAL(EB) :: SUM
REAL(FB) :: STIME
INTEGER  :: ISOOFFSET,DATAFLAG,I,J,K,N,ERROR, HAVE_ISO2
REAL(EB), POINTER, DIMENSION(:,:,:) :: QUANTITY,QUANTITY2, B,S

IF (EVACUATION_ONLY(NM)) RETURN

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
DATAFLAG = 1
DRY=.FALSE.

CALL POINT_TO_MESH(NM)

! Create arrays, B and IBLK, that are 1 in open cells and 0 in solid cells.

IBLK = 1
B => WORK1
B = 1._EB

DO K=1,KBAR
   DO J=1,JBAR
      DO I=1,IBAR
         IF (SOLID(CELL_INDEX(I,J,K))) THEN
            B(I,J,K) = 0._EB
            IBLK(I,J,K) = 0
         ENDIF
      ENDDO
   ENDDO
ENDDO

! Create an array, S, that is the reciprocal of the sum of the B values.

S => WORK2
S = 0._EB

DO K=0,KBAR
   DO J=0,JBAR
      DO I=0,IBAR
         SUM = B(I,J,K)+B(I+1,J+1,K+1)+B(I+1,J,K)+B(I,J+1,K)+B(I,J,K+1)+ B(I+1,J+1,K)+B(I+1,J,K+1)+B(I,J+1,K+1)
         IF (SUM>0._EB) S(I,J,K) = 1._EB/SUM
      ENDDO
   ENDDO
ENDDO

! Run through ISOF files

QUANTITY => WORK3

ISOF_LOOP: DO N=1,N_ISOF
   IS => ISOSURFACE_FILE(N)
   ERROR = 0
   ISOOFFSET = 1
   HAVE_ISO2 = 0

   ! Fill up the dummy array QUANTITY with the appropriate gas phase output

   DO K=0,KBP1
      DO J=0,JBP1
         DO I=0,IBP1
            QUANTITY(I,J,K) = GAS_PHASE_OUTPUT(I,J,K,IS%INDEX,0,IS%Y_INDEX,IS%Z_INDEX,0,IS%VELO_INDEX,0,0,0,0,T,DT,NM)
         ENDDO
      ENDDO
   ENDDO

   ! Average the data (which is assumed to be cell-centered) at cell corners

   DO K=0,KBAR
      DO J=0,JBAR
         DO I=0,IBAR
            QQ(I+1,J+1,K+1,1) = REAL(S(I,J,K)*(QUANTITY(I,J,K)*B(I,J,K)        + QUANTITY(I+1,J,K)*B(I+1,J,K)+ &
                                               QUANTITY(I,J,K+1)*B(I,J,K+1)    + QUANTITY(I+1,J,K+1)*B(I+1,J,K+1)+ &
                                               QUANTITY(I,J+1,K)*B(I,J+1,K)    + QUANTITY(I+1,J+1,K)*B(I+1,J+1,K)+ &
                                               QUANTITY(I,J+1,K+1)*B(I,J+1,K+1)+ QUANTITY(I+1,J+1,K+1)*B(I+1,J+1,K+1)),FB)
         ENDDO
      ENDDO
   ENDDO

   ! Fill up QUANTITY2 and QQ2 arrays if the isosurface is colored with a second quantity

   IF ( IS%INDEX2 /= -1 ) THEN
      HAVE_ISO2 = 1
      QUANTITY2 => WORK4

   ! Fill up the dummy array QUANTITY2 with the appropriate gas phase output

      DO K=0,KBP1
         DO J=0,JBP1
            DO I=0,IBP1
               QUANTITY2(I,J,K) = GAS_PHASE_OUTPUT(I,J,K,IS%INDEX2,0,IS%Y_INDEX2,IS%Z_INDEX2,0,IS%VELO_INDEX2,0,0,0,0,T,DT,NM)
            ENDDO
         ENDDO
      ENDDO

   ! Average the data (which is assumed to be cell-centered) at cell corners

      DO K=0,KBAR
         DO J=0,JBAR
            DO I=0,IBAR
               QQ2(I+1,J+1,K+1,1) = REAL(S(I,J,K)*(QUANTITY2(I,J,K)*B(I,J,K)        + QUANTITY2(I+1,J,K)*B(I+1,J,K)+ &
                                                   QUANTITY2(I,J,K+1)*B(I,J,K+1)    + QUANTITY2(I+1,J,K+1)*B(I+1,J,K+1)+ &
                                                   QUANTITY2(I,J+1,K)*B(I,J+1,K)    + QUANTITY2(I+1,J+1,K)*B(I+1,J+1,K)+ &
                                                   QUANTITY2(I,J+1,K+1)*B(I,J+1,K+1)+ QUANTITY2(I+1,J+1,K+1)*B(I+1,J+1,K+1)),FB)
            ENDDO
         ENDDO
      ENDDO
   ENDIF

   CALL ISO_TO_FILE(LU_ISOF(N,NM),LU_ISOF2(N,NM),NM,IBAR,JBAR,KBAR,STIME,QQ,QQ2,HAVE_ISO2,&
        IS%VALUE(1:IS%N_VALUES), IS%N_VALUES, IBLK, IS%SKIP, IS%DELTA, XPLT, IBP1, YPLT, JBP1, ZPLT, KBP1)

ENDDO ISOF_LOOP

END SUBROUTINE DUMP_ISOF



SUBROUTINE DUMP_SMOKE3D(T,DT,NM)

! Write out the SMOKE3D data to files

USE COMPLEX_GEOMETRY, ONLY : IBM_VGSC,IBM_SOLID

REAL(EB), INTENT(IN) :: T,DT
INTEGER,  INTENT(IN) :: NM
INTEGER  :: I,J,K,N
REAL(FB) :: DXX,MASS_EXT_COEF,STIME
REAL(EB), POINTER, DIMENSION(:,:,:) :: FF
REAL(FB), ALLOCATABLE, DIMENSION(:) :: QQ_PACK

IF (EVACUATION_ONLY(NM)) RETURN

CALL POINT_TO_MESH(NM)

! Miscellaneous settings

DRY   = .FALSE.
STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
DXX   = REAL(DX(1),FB)
FF   => WORK3

DATA_FILE_LOOP: DO N=1,4

   IF (SMOKE3D_QUANTITY_INDEX(N)==0) CYCLE DATA_FILE_LOOP

   ! Set the appropriate extinction coefficient

   IF (SMOKE3D_Y_INDEX(N) > 0) THEN
      MASS_EXT_COEF = REAL(SPECIES(SMOKE3D_Y_INDEX(N))%MASS_EXTINCTION_COEFFICIENT,FB)
   ELSEIF (SMOKE3D_Z_INDEX(N) >= 0) THEN
      MASS_EXT_COEF = REAL(SPECIES_MIXTURE(SMOKE3D_Z_INDEX(N))%MASS_EXTINCTION_COEFFICIENT,FB)
   ELSE
      MASS_EXT_COEF = 0._FB
   ENDIF

   ! Write out soot, hrrpuv, temperature and co2 data files (if they exist)

   DO K=0,KBP1
      DO J=0,JBP1
         DO I=0,IBP1
            FF(I,J,K)=GAS_PHASE_OUTPUT(I,J,K,SMOKE3D_QUANTITY_INDEX(N),0,SMOKE3D_Y_INDEX(N),SMOKE3D_Z_INDEX(N),0,0,0,0,0,0,T,DT,NM)
         ENDDO
      ENDDO
   ENDDO

   ! Interpolate data to cell nodes

   DO K=0,KBAR
      DO J=0,JBAR
         DO I=0,IBAR
            QQ(I,J,K,1) = REAL((FF(I,J,K)  +FF(I+1,J,K)  +FF(I,J,K+1)  +FF(I+1,J,K+1)+ &
                                FF(I,J+1,K)+FF(I+1,J+1,K)+FF(I,J+1,K+1)+FF(I+1,J+1,K+1))*0.125_FB,FB)
         ENDDO
      ENDDO
   ENDDO

   IF (CC_IBM) THEN
      DO K=0,KBAR
         DO J=0,JBAR
            DO I=0,IBAR
               IF(MESHES(NM)%VERTVAR(I,J,K,IBM_VGSC) /= IBM_SOLID) CYCLE
               QQ(I,J,K,1) = 0._FB
            ENDDO
         ENDDO
      ENDDO
   ENDIF

   ! Pack the data into a 1-D array and call routine that writes the file

   ALLOCATE(QQ_PACK(IBP1*JBP1*KBP1))
   QQ_PACK = PACK(QQ(0:IBAR,0:JBAR,0:KBAR,1),MASK=.TRUE.)
   CALL SMOKE3D_TO_FILE(LU_SMOKE3D(N,NM),LU_SMOKE3D(N+4,NM),STIME,DXX,MASS_EXT_COEF,N,QQ_PACK,IBP1,JBP1,KBP1,&
                        HRRPUV_MAX_SMV,TEMP_MAX_SMV)
   DEALLOCATE(QQ_PACK)

ENDDO DATA_FILE_LOOP

END SUBROUTINE DUMP_SMOKE3D

! ---------------------------- GETSLICEDIR ----------------------------------------

SUBROUTINE GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
INTEGER, INTENT(IN) :: I1, I2, J1, J2, K1, K2
INTEGER, INTENT(OUT) :: DIR, SLICE

IF (ABS(K1-K2)<MIN(ABS(I1-I2),ABS(J1-J2))) THEN
   DIR=3
   SLICE = K1
ELSE IF (ABS(J1-J2)<MIN(ABS(I1-I2),ABS(K1-K2))) THEN
   DIR=2
   SLICE = J1
ELSE
   DIR=1
   SLICE = I1
ENDIF
RETURN

END SUBROUTINE GETSLICEDIR

! ---------------------------- IJK ----------------------------------------

INTEGER FUNCTION IJK(I,J,NI)
INTEGER, INTENT(IN) :: I, J, NI
IJK = I + (J-1)*NI
END FUNCTION IJK

! ---------------------------- GET_GEOMSIZES ----------------------------------------

SUBROUTINE GET_GEOMSIZES(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS)
USE COMPLEX_GEOMETRY

! determine NVERTS and NFACES for one of the following cases
!
! IGNORE_GEOM  - creates a slice file geometry file that ignores immersed geometric objects .  Triangles inside obstacle
!                regions (a solid) are tagged with a 1, triangles outside of obstacle regions (the gas) are tagged
!                with a 0 . Smokeview uses this information to show/hide these two regions
! INCLUDE_GEOM - creates a slice file geometry file that accounts for immersed geometric objects .  If there are no immersed
!                objects present then this slice type is equivalent to the 'IGNORE_GEOM' case.  Triangles completely inside a
!                solid are tagged with a 1, triangles completely in the gas are tagged with a 0 and triangles in a cutcell are
!                with a tagged 2.  As with the IGNORE_GEOM type, Smokeview uses this information to show/hide these regions

   CHARACTER(*), INTENT(IN) :: SLICETYPE
   INTEGER, INTENT(IN) :: I1,I2,J1,J2,K1,K2
   INTEGER, INTENT(OUT) :: NVERTS, NVERTS_CUTCELLS, NFACES, NFACES_CUTCELLS

   INTEGER :: DIR,SLICE
   INTEGER :: I, J, K
   INTEGER :: ICF, IFACE, NVF, IEXIM, ICC, JCC, ICF2, IFACE2, NFC, ICCF

   CHARACTER(LEN=100) :: SLICETYPE_LOCAL

   SLICETYPE_LOCAL=TRIM(SLICETYPE) ! only generate CUTCELLS slice files if the immersed geometry option is turned on
   IF (SLICETYPE=='INCLUDE_GEOM' .AND. .NOT.CC_IBM) SLICETYPE_LOCAL='IGNORE_GEOM'

   NVERTS=0
   NFACES=0
   NVERTS_CUTCELLS=0
   NFACES_CUTCELLS=0
   IF (SLICETYPE_LOCAL=='IGNORE_GEOM') THEN
      CALL GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
      IF (DIR==1) THEN
        NVERTS = (J2 + 1 - J1)*(K2 + 1 - K1)
        NFACES = 2*(J2 - J1)*(K2 - K1)
      ELSE IF (DIR==2) THEN
        NVERTS = (I2 + 1 - I1)*(K2 + 1 - K1)
        NFACES = 2*(I2 - I1)*(K2 - K1)
      ELSE
        NVERTS = (I2 + 1 - I1)*(J2 + 1 - J1)
        NFACES = 2*(I2 - I1)*(J2 - J1)
      ENDIF
   ELSE IF (SLICETYPE_LOCAL=='INCLUDE_GEOM') THEN
      CALL GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
      IF (DIR==1) THEN
         NVERTS = (J2 + 1 - J1)*(K2 + 1 - K1)
         NFACES = 0
         DO K = K1+1, K2
            DO J = J1+1, J2
               IF (FCVAR(SLICE,J,K,IBM_FGSC,IAXIS) == IBM_CUTCFE) THEN
                  ICF = FCVAR(SLICE,J,K,IBM_IDCF,IAXIS) ! a cutcell so count number of faces
                  DO IFACE=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE ! Adds also SOLID side faces.
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACE)
                     NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                     NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                  ENDDO
               ELSE
                  NFACES = NFACES + 2 ! a gas or solid cell so add 2 to the number of faces
               ENDIF
            END DO
         END DO
      ELSE IF (DIR==2) THEN
         NVERTS = (I2 + 1 - I1)*(K2 + 1 - K1)
         DO K = K1+1, K2
            DO I = I1+1, I2
               IF (FCVAR(I,SLICE,K,IBM_FGSC,JAXIS) == IBM_CUTCFE) THEN
                  ICF = FCVAR(I,SLICE,K,IBM_IDCF,JAXIS)
                  DO IFACE=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE ! Adds also SOLID side faces.
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACE)
                     NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                     NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                  ENDDO
               ELSE
                  NFACES = NFACES + 2
               ENDIF
            END DO
         END DO
      ELSE
         NVERTS = (I2 + 1 - I1)*(J2 + 1 - J1)
         DO I = I1+1, I2
            DO J = J1+1, J2
               IF (FCVAR(I,J,SLICE,IBM_FGSC,KAXIS) == IBM_CUTCFE) THEN
                  ICF = FCVAR(I,J,SLICE,IBM_IDCF,KAXIS)
                  DO IFACE=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE ! Adds also SOLID side faces.
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACE)
                     NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                     NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                  ENDDO
               ELSE
                  NFACES = NFACES + 2
               ENDIF
            END DO
         END DO
      ENDIF
   ELSE IF (SLICETYPE_LOCAL=='INBOUND_FACES') THEN
      DO K = 1, KBAR
         DO J = 1, JBAR
            DO I = 1, IBAR
               IF (CCVAR(I,J,K,IBM_IDCF) > 0) THEN ! There are INBOUNDARY cut-faces on this cell:
                  ICF = CCVAR(I,J,K,IBM_IDCF)
                  DO IFACE=1,CUT_FACE(ICF)%NFACE ! Adds also SOLID side faces.
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACE)
                     NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                     NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                  ENDDO
               ENDIF
            END DO
         END DO
      END DO
   ELSE IF (SLICETYPE_LOCAL=='EXIMBND_FACES') THEN
      NVF = 4 ! 4 Vertices for EXIM regular face.
      DO IEXIM=1,IBM_NEXIMFACE_MESH
         NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
         NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
      ENDDO
   ELSE IF (SLICETYPE_LOCAL=='CUT_CELLS') THEN
      DO K = 1, KBAR
         DO J = 1, JBAR
            DO I = 1, IBAR
               IF (CCVAR(I,J,K,IBM_IDCC) <= 0) CYCLE
               ICC = CCVAR(I,J,K,IBM_IDCC)
               DO JCC=1,CUT_CELL(ICC)%NCELL
                  NFC=CUT_CELL(ICC)%CCELEM(1,JCC)
                  ! Loop on faces corresponding to cut-cell ICC2:
                  DO ICCF=1,NFC
                     IFACE=CUT_CELL(ICC)%CCELEM(ICCF+1,JCC)
                     SELECT CASE(CUT_CELL(ICC)%FACE_LIST(1,IFACE))
                     CASE(IBM_FTYPE_RGGAS) ! REGULAR GASPHASE
                        NVF = 4
                        NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                        NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                     CASE(IBM_FTYPE_CFGAS)
                        ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                        IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                        NVF=CUT_FACE(ICF2)%CFELEM(1,IFACE2)
                        NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                        NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                     CASE(IBM_FTYPE_CFINB)
                        ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                        IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                        NVF=CUT_FACE(ICF2)%CFELEM(1,IFACE2)
                        NFACES_CUTCELLS = NFACES_CUTCELLS + NVF - 2
                        NVERTS_CUTCELLS = NVERTS_CUTCELLS + NVF
                     END SELECT
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
   ENDIF
   NFACES = NFACES + NFACES_CUTCELLS
   NVERTS = NVERTS + NVERTS_CUTCELLS
END SUBROUTINE GET_GEOMSIZES

! ---------------------------- GET_GEOMINFO ----------------------------------------

SUBROUTINE GET_GEOMINFO(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS,VERTS,FACES,LOCATIONS)
USE COMPLEX_GEOMETRY

 ! generate VERTS(1:3*NVERTS) and FACES(1:3*NFACES) arrays

   CHARACTER(*), INTENT(IN) :: SLICETYPE
   INTEGER, INTENT(IN) :: I1,I2,J1,J2,K1,K2
   INTEGER, INTENT(IN) :: NVERTS, NVERTS_CUTCELLS, NFACES, NFACES_CUTCELLS
   INTEGER, INTENT(OUT), DIMENSION(3*NFACES), TARGET :: FACES
   INTEGER, INTENT(OUT), DIMENSION(NFACES) :: LOCATIONS
   REAL(FB), INTENT(OUT), DIMENSION(3*NVERTS), TARGET :: VERTS

   INTEGER :: VERT_OFFSET
   INTEGER, POINTER, DIMENSION(:) :: FACEPTR
   REAL(FB), POINTER, DIMENSION(:) :: VERTPTR

   INTEGER :: DIR, SLICE
   INTEGER :: NI, NJ, NK
   INTEGER :: I, J, K
   INTEGER IFACE, IVERT, IVERTCUT, IFACECUT, IVERTCF, IFACECF
   INTEGER VERTBEG, VERTEND, FACEBEG, FACEEND
   LOGICAL IS_SOLID
   INTEGER :: ICF, NVF, IVCF, IADD, JADD, KADD, IEXIM, X1AXIS
   INTEGER :: II, JJ, KK, ICC, JCC, NFC, ICCF, LOWHIGH, ILH, ICF2, IFACE2
   INTEGER, ALLOCATABLE, DIMENSION(:) :: LOCTYPE

   CHARACTER(LEN=100) :: SLICETYPE_LOCAL

   SLICETYPE_LOCAL=TRIM(SLICETYPE) ! only generate CUTCELLS slice files if the immersed geometry option is turned on
   IF (SLICETYPE=='INCLUDE_GEOM' .AND. .NOT.CC_IBM) SLICETYPE_LOCAL='IGNORE_GEOM'

   LOCATIONS = 0 ! initially assume triangles are in gas and tag with 0
   IF (SLICETYPE_LOCAL=='IGNORE_GEOM') THEN
      NI = I2 + 1 - I1
      NJ = J2 + 1 - J1
      NK = K2 + 1 - K1
      CALL GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
      IVERT = 0
      IFACE = 0
      IF (DIR==1) THEN
         DO K=K1,K2
            DO J=J1,J2
               DO I = SLICE,SLICE
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(SLICE)
                  VERTS(3*IVERT-1) = YPLT(J)
                  VERTS(3*IVERT)   = ZPLT(K)
               END DO
            END DO
         END DO
         DO K=1,NK-1
            DO J=1,NJ-1
               IS_SOLID = SOLID(CELL_INDEX(SLICE,J+J1,K+K1))
               IFACE = IFACE + 1
               IF (IS_SOLID)LOCATIONS(IFACE) = 1 + 16 ! triangle is in a solid so tag with 1
               FACES(3*IFACE-2) = IJK(  J,  K,NJ)
               FACES(3*IFACE-1) = IJK(J+1,  K,NJ)
               FACES(3*IFACE)   = IJK(J+1,K+1,NJ)

               IFACE = IFACE + 1
               IF (IS_SOLID)LOCATIONS(IFACE) = 1 + 4 ! triangle is in a solid so tag with 1
               FACES(3*IFACE-2) = IJK(  J,  K,NJ)
               FACES(3*IFACE-1) = IJK(J+1,K+1,NJ)
               FACES(3*IFACE)   = IJK(  J,K+1,NJ)
            END DO
         END DO
      ELSE IF (DIR==2) THEN
         DO K=K1,K2
            DO J=SLICE,SLICE
               DO I = I1,I2
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(I)
                  VERTS(3*IVERT-1) = YPLT(SLICE)
                  VERTS(3*IVERT)   = ZPLT(K)
               END DO
            END DO
         END DO
         DO K=1,NK-1
            DO I=1,NI-1
               IS_SOLID = SOLID(CELL_INDEX(I+I1,SLICE,K+K1))
               IFACE = IFACE + 1
               IF (IS_SOLID)LOCATIONS(IFACE) = 1 + 16
               FACES(3*IFACE-2) = IJK(  I,  K,NI)
               FACES(3*IFACE-1) = IJK(I+1,  K,NI)
               FACES(3*IFACE)   = IJK(I+1,K+1,NI)

               IFACE = IFACE + 1
               IF (IS_SOLID)LOCATIONS(IFACE) = 1 + 4
               FACES(3*IFACE-2) = IJK(  I,  K,NI)
               FACES(3*IFACE-1) = IJK(I+1,K+1,NI)
               FACES(3*IFACE)   = IJK(  I,K+1,NI)
            END DO
         END DO
      ELSE
         DO K=SLICE,SLICE
            DO J=J1,J2
               DO I = I1,I2
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(I)
                  VERTS(3*IVERT-1) = YPLT(J)
                  VERTS(3*IVERT)   = ZPLT(SLICE)
               END DO
            END DO
         END DO
         DO J=1,NJ-1
            DO I=1,NI-1
               IS_SOLID = SOLID(CELL_INDEX(I+I1,J+J1,SLICE))
               IFACE = IFACE + 1
               IF (IS_SOLID) LOCATIONS(IFACE) = 1 + 16
               FACES(3*IFACE-2) = IJK(  I,  J,NI)
               FACES(3*IFACE-1) = IJK(I+1,  J,NI)
               FACES(3*IFACE)   = IJK(I+1,J+1,NI)

               IFACE = IFACE + 1
               IF (IS_SOLID) LOCATIONS(IFACE) = 1 + 4
               FACES(3*IFACE-2) = IJK(  I,  J,NI)
               FACES(3*IFACE-1) = IJK(I+1,J+1,NI)
               FACES(3*IFACE)   = IJK(  I,J+1,NI)
            END DO
         END DO
      ENDIF
   ELSE IF (SLICETYPE_LOCAL=='INCLUDE_GEOM') THEN
      IVERTCUT=NVERTS-NVERTS_CUTCELLS ! start cutcell counters after 'regular' cells
      IFACECUT=NFACES-NFACES_CUTCELLS
      NI = I2 + 1 - I1
      NJ = J2 + 1 - J1
      NK = K2 + 1 - K1
      CALL GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
      IVERT = 0
      IFACE = 0
      IF (DIR==1) THEN
         DO K=K1,K2
            DO J=J1,J2
               DO I = SLICE,SLICE
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(SLICE)
                  VERTS(3*IVERT-1) = YPLT(J)
                  VERTS(3*IVERT)   = ZPLT(K)
               END DO
            END DO
         END DO
         DO K=1,NK-1
            DO J=1,NJ-1
               IF (FCVAR(SLICE,J,K,IBM_FGSC,IAXIS) == IBM_CUTCFE) THEN
                  ICF = FCVAR(SLICE,J,K,IBM_IDCF,IAXIS) ! store cutcell faces and vertices
                  DO IFACECF=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                     VERTBEG = IVERTCUT + 1
                     VERTBEG = 3*VERTBEG - 2
                     VERTEND = IVERTCUT + NVF
                     VERTEND = 3*VERTEND
                     DO IVCF=1,NVF
                        IVERTCUT = IVERTCUT + 1
                        IVERTCF=CUT_FACE(ICF)%CFELEM(IVCF+1,IFACECF)
                        VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF)%XYZVERT(1:3,IVERTCF),FB)
                     ENDDO

                     FACEBEG = 3*(IFACECUT+1) - 2
                     FACEEND = FACEBEG + 3*(NVF-2) - 1
                     FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                     VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                     VERT_OFFSET = IVERTCUT - NVF
                     ALLOCATE(LOCTYPE(NVF-2))
                     CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                     DO IVCF = 1, NVF-2 ! for now assume face is convex
                        ! vertex indices 1, 2, ..., NVF
                        ! faces (1,2,3), (1,3,4), ..., (1,NVF-1,NVF)
                        IFACECUT = IFACECUT + 1
                        LOCATIONS(IFACECUT) = 2 + LOCTYPE(IVCF)
                        IF(IFACECF > CUT_FACE(ICF)%NFACE) LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Solid side cut-faces.
! after TRIANGULATE is verified remove the following 3 lines of code (and similar lines in 2 locations below)
!                        FACES(3*IFACECUT-2) = (IVERTCUT-NVF)+1
!                        FACES(3*IFACECUT-1) = (IVERTCUT-NVF)+1+IVCF
!                        FACES(3*IFACECUT)   = (IVERTCUT-NVF)+2+IVCF
                     ENDDO
                     DEALLOCATE(LOCTYPE)
                  ENDDO
               ELSE
                  IFACE = IFACE + 1 ! store solid and gas faces and vertices (2 faces per cell)
                  LOCATIONS(IFACE) = 0 + 16
                  IF ( FCVAR(SLICE,J,K,IBM_FGSC,IAXIS) == IBM_SOLID) LOCATIONS(IFACE)=1 + 16
                  FACES(3*IFACE-2) = IJK(  J,  K,NJ)
                  FACES(3*IFACE-1) = IJK(J+1,  K,NJ)
                  FACES(3*IFACE)   = IJK(J+1,K+1,NJ)

                  IFACE = IFACE + 1
                  LOCATIONS(IFACE) = 0 + 4
                  IF ( FCVAR(SLICE,J,K,IBM_FGSC,IAXIS) == IBM_SOLID) LOCATIONS(IFACE)=1 + 4
                  FACES(3*IFACE-2) = IJK(  J,  K,NJ)
                  FACES(3*IFACE-1) = IJK(J+1,K+1,NJ)
                  FACES(3*IFACE)   = IJK(  J,K+1,NJ)
               ENDIF
            END DO
         END DO
      ELSE IF (DIR==2) THEN
         DO K=K1,K2
            DO J=SLICE,SLICE
               DO I = I1,I2
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(I)
                  VERTS(3*IVERT-1) = YPLT(SLICE)
                  VERTS(3*IVERT)   = ZPLT(K)
               END DO
            END DO
         END DO
         DO K=1,NK-1
            DO I=1,NI-1
               IF (FCVAR(I,SLICE,K,IBM_FGSC,JAXIS) == IBM_CUTCFE) THEN
                  ICF = FCVAR(I,SLICE,K,IBM_IDCF,JAXIS)
                  DO IFACECF=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                     VERTBEG = IVERTCUT + 1
                     VERTBEG = 3*VERTBEG - 2
                     VERTEND = IVERTCUT + NVF
                     VERTEND = 3*VERTEND
                     DO IVCF=1,NVF
                        IVERTCUT = IVERTCUT + 1
                        IVERTCF=CUT_FACE(ICF)%CFELEM(IVCF+1,IFACECF)
                        VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF)%XYZVERT(1:3,IVERTCF),FB)
                     ENDDO
                     FACEBEG = 3*(IFACECUT+1) - 2
                     FACEEND = FACEBEG + 3*(NVF-2) - 1
                     FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                     VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                     VERT_OFFSET = IVERTCUT - NVF
                     ALLOCATE(LOCTYPE(NVF-2))
                     CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                     DO IVCF = 1, NVF-2 ! for now assume face is convex
                        IFACECUT = IFACECUT + 1
                        LOCATIONS(IFACECUT) = 2 + LOCTYPE(IVCF)
                        IF(IFACECF > CUT_FACE(ICF)%NFACE) LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Solid side cut-faces.
!                        FACES(3*IFACECUT-2) = IVERTCUT-NVF+1
!                        FACES(3*IFACECUT-1) = IVERTCUT-NVF+1+IVCF
!                        FACES(3*IFACECUT)   = IVERTCUT-NVF+1+IVCF+1
                     ENDDO
                     DEALLOCATE(LOCTYPE)
                  ENDDO
               ELSE
                  IFACE = IFACE + 1
                  LOCATIONS(IFACE) = 0 + 16
                  IF ( FCVAR(I,SLICE,K,IBM_FGSC,JAXIS) == IBM_SOLID) LOCATIONS(IFACE)=1 + 16
                  FACES(3*IFACE-2) = IJK(  I,  K,NI)
                  FACES(3*IFACE-1) = IJK(I+1,  K,NI)
                  FACES(3*IFACE)   = IJK(I+1,K+1,NI)

                  IFACE = IFACE + 1
                  LOCATIONS(IFACE) = 0 + 4
                  IF ( FCVAR(I,SLICE,K,IBM_FGSC,JAXIS) == IBM_SOLID) LOCATIONS(IFACE)=1 + 4
                  FACES(3*IFACE-2) = IJK(  I,  K,NI)
                  FACES(3*IFACE-1) = IJK(I+1,K+1,NI)
                  FACES(3*IFACE)   = IJK(  I,K+1,NI)
               ENDIF
            END DO
         END DO
      ELSE
         DO K=SLICE,SLICE
            DO J=J1,J2
               DO I = I1,I2
                  IVERT = IVERT + 1
                  VERTS(3*IVERT-2) = XPLT(I)
                  VERTS(3*IVERT-1) = YPLT(J)
                  VERTS(3*IVERT)   = ZPLT(SLICE)
               END DO
            END DO
         END DO
         DO J=1,NJ-1
            DO I=1,NI-1
               IF (FCVAR(I,J,SLICE,IBM_FGSC,KAXIS) == IBM_CUTCFE) THEN
                  ICF = FCVAR(I,J,SLICE,IBM_IDCF,KAXIS)
                  DO IFACECF=1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                     NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                     VERTBEG = IVERTCUT + 1
                     VERTBEG = 3*VERTBEG - 2
                     VERTEND = IVERTCUT + NVF
                     VERTEND = 3*VERTEND
                     DO IVCF=1,NVF
                        IVERTCUT = IVERTCUT + 1
                        IVERTCF=CUT_FACE(ICF)%CFELEM(IVCF+1,IFACECF)
                        VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF)%XYZVERT(1:3,IVERTCF),FB)
                     ENDDO
                     FACEBEG = 3*(IFACECUT+1) - 2
                     FACEEND = FACEBEG + 3*(NVF-2) - 1
                     FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                     VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                     VERT_OFFSET = IVERTCUT - NVF
                     ALLOCATE(LOCTYPE(NVF-2))
                     CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                     DO IVCF = 1, NVF-2 ! for now assume face is convex
                        IFACECUT = IFACECUT + 1
                        LOCATIONS(IFACECUT) = 2 + LOCTYPE(IVCF)
                        IF(IFACECF > CUT_FACE(ICF)%NFACE) LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Solid side cut-faces.
!                        FACES(3*IFACECUT-2) = IVERTCUT-NVF+1
!                        FACES(3*IFACECUT-1) = IVERTCUT-NVF+1+IVCF
!                        FACES(3*IFACECUT)   = IVERTCUT-NVF+1+IVCF+1
                     ENDDO
                     DEALLOCATE(LOCTYPE)
                  ENDDO
               ELSE
                  IFACE = IFACE + 1
                  LOCATIONS(IFACE) = 0 + 16
                  IF ( FCVAR(I,J,SLICE,IBM_FGSC,KAXIS) == IBM_SOLID) LOCATIONS(IFACE)=1 + 16
                  FACES(3*IFACE-2) = IJK(  I,  J,NI)
                  FACES(3*IFACE-1) = IJK(I+1,  J,NI)
                  FACES(3*IFACE)   = IJK(I+1,J+1,NI)

                  IFACE = IFACE + 1
                  LOCATIONS(IFACE) = 0 + 4
                  IF ( FCVAR(I,J,SLICE,IBM_FGSC,KAXIS) == IBM_SOLID) LOCATIONS(IFACE)=1 + 4
                  FACES(3*IFACE-2) = IJK(  I,  J,NI)
                  FACES(3*IFACE-1) = IJK(I+1,J+1,NI)
                  FACES(3*IFACE)   = IJK(  I,J+1,NI)
               ENDIF
            END DO
         END DO
      ENDIF
   ELSE IF (SLICETYPE_LOCAL=='INBOUND_FACES') THEN
      DIR   = 0
      IVERTCUT=NVERTS-NVERTS_CUTCELLS ! start cutcell counters after 'regular' cells
      IFACECUT=NFACES-NFACES_CUTCELLS
      DO K=1,KBAR
         DO J=1,JBAR
            DO I=1,IBAR
            IF (CCVAR(I,J,K,IBM_IDCF) > 0) THEN
               ICF = CCVAR(I,J,K,IBM_IDCF)
               DO IFACECF=1,CUT_FACE(ICF)%NFACE
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  VERTBEG = IVERTCUT + 1
                  VERTBEG = 3*VERTBEG - 2
                  VERTEND = IVERTCUT + NVF
                  VERTEND = 3*VERTEND
                  DO IVCF=1,NVF
                     IVERTCUT = IVERTCUT + 1
                     IVERTCF=CUT_FACE(ICF)%CFELEM(IVCF+1,IFACECF)
                     VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF)%XYZVERT(1:3,IVERTCF),FB)
                  ENDDO
                  FACEBEG = 3*(IFACECUT+1) - 2
                  FACEEND = FACEBEG + 3*(NVF-2) - 1
                  FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                  VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                  VERT_OFFSET = IVERTCUT - NVF
                  ALLOCATE(LOCTYPE(NVF-2))
                  CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                  DO IVCF = 1, NVF-2 ! for now assume face is convex
                     IFACECUT = IFACECUT + 1
                     LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Consider them as SOLID.
                  ENDDO
                  DEALLOCATE(LOCTYPE)
               ENDDO
            ENDIF
            ENDDO
         ENDDO
      ENDDO
   ELSE IF (SLICETYPE_LOCAL=='EXIMBND_FACES') THEN
      IVERTCUT=NVERTS-NVERTS_CUTCELLS ! start cutcell counters after 'regular' cells
      IFACECUT=NFACES-NFACES_CUTCELLS
      DO IEXIM=1,IBM_NEXIMFACE_MESH
         I      = IBM_EXIM_FACE(IEXIM)%IJK(IAXIS)
         J      = IBM_EXIM_FACE(IEXIM)%IJK(JAXIS)
         K      = IBM_EXIM_FACE(IEXIM)%IJK(KAXIS)
         X1AXIS = IBM_EXIM_FACE(IEXIM)%IJK(KAXIS+1)
         SELECT CASE(X1AXIS)
         CASE(IAXIS)
            DO KADD=-1,0
               DO JADD=-1,0
                  IVERTCUT = IVERTCUT + 1
                  VERTS(3*IVERTCUT-2) = REAL(X(I     ),FB)
                  VERTS(3*IVERTCUT-1) = REAL(Y(J+JADD),FB)
                  VERTS(3*IVERTCUT)   = REAL(Z(K+KADD),FB)
               ENDDO
            ENDDO
         CASE(JAXIS)
            DO IADD=-1,0
               DO KADD=-1,0
                  IVERTCUT = IVERTCUT + 1
                  VERTS(3*IVERTCUT-2) = REAL(X(I+IADD),FB)
                  VERTS(3*IVERTCUT-1) = REAL(Y(J     ),FB)
                  VERTS(3*IVERTCUT)   = REAL(Z(K+KADD),FB)
               ENDDO
            ENDDO
         CASE(KAXIS)
            DO JADD=-1,0
               DO IADD=-1,0
                  IVERTCUT = IVERTCUT + 1
                  VERTS(3*IVERTCUT-2) = REAL(X(I+IADD),FB)
                  VERTS(3*IVERTCUT-1) = REAL(Y(J+JADD),FB)
                  VERTS(3*IVERTCUT)   = REAL(Z(K     ),FB)
               ENDDO
            ENDDO
         END SELECT
         IFACECUT = IFACECUT + 1
         LOCATIONS(IFACECUT) = 1 + 16
         FACES(3*IFACECUT-2:3*IFACECUT) = (/ IVERTCUT-3, IVERTCUT-2, IVERTCUT   /) ! Local Nodes 1, 2, 4

         IFACECUT = IFACECUT + 1
         LOCATIONS(IFACECUT) = 1 + 16
         FACES(3*IFACECUT-2:3*IFACECUT) = (/ IVERTCUT  , IVERTCUT-1, IVERTCUT-3 /) ! Local Nodes 4, 3, 1
      ENDDO
   ELSE IF (SLICETYPE_LOCAL=='CUT_CELLS') THEN
      IVERTCUT=NVERTS-NVERTS_CUTCELLS ! start cutcell counters after 'regular' cells
      IFACECUT=NFACES-NFACES_CUTCELLS
      DO KK = 1, KBAR
         DO JJ = 1, JBAR
            DO II = 1, IBAR
               IF (CCVAR(II,JJ,KK,IBM_IDCC) <= 0) CYCLE
               ICC = CCVAR(II,JJ,KK,IBM_IDCC)
               DO JCC=1,CUT_CELL(ICC)%NCELL
                  NFC=CUT_CELL(ICC)%CCELEM(1,JCC)
                  ! Loop on faces corresponding to cut-cell ICC2:
                  DO ICCF=1,NFC
                     IFACE=CUT_CELL(ICC)%CCELEM(ICCF+1,JCC)
                     SELECT CASE(CUT_CELL(ICC)%FACE_LIST(1,IFACE))
                     CASE(IBM_FTYPE_RGGAS) ! REGULAR GASPHASE
                        LOWHIGH = CUT_CELL(ICC)%FACE_LIST(2,IFACE)
                        X1AXIS  = CUT_CELL(ICC)%FACE_LIST(3,IFACE)
                        ILH     = LOWHIGH - 1
                        I=II; J=JJ; K=KK;
                        SELECT CASE(X1AXIS)
                        CASE(IAXIS)
                           I=II-FCELL+ILH
                           DO KADD=-1,0
                              DO JADD=-1,0
                                 IVERTCUT = IVERTCUT + 1
                                 VERTS(3*IVERTCUT-2) = REAL(X(I     ),FB)
                                 VERTS(3*IVERTCUT-1) = REAL(Y(J+JADD),FB)
                                 VERTS(3*IVERTCUT)   = REAL(Z(K+KADD),FB)
                              ENDDO
                           ENDDO
                        CASE(JAXIS)
                           J=JJ-FCELL+ILH
                           DO IADD=-1,0
                              DO KADD=-1,0
                                 IVERTCUT = IVERTCUT + 1
                                 VERTS(3*IVERTCUT-2) = REAL(X(I+IADD),FB)
                                 VERTS(3*IVERTCUT-1) = REAL(Y(J     ),FB)
                                 VERTS(3*IVERTCUT)   = REAL(Z(K+KADD),FB)
                              ENDDO
                           ENDDO
                        CASE(KAXIS)
                           K=KK-FCELL+ILH
                           DO JADD=-1,0
                              DO IADD=-1,0
                                 IVERTCUT = IVERTCUT + 1
                                 VERTS(3*IVERTCUT-2) = REAL(X(I+IADD),FB)
                                 VERTS(3*IVERTCUT-1) = REAL(Y(J+JADD),FB)
                                 VERTS(3*IVERTCUT)   = REAL(Z(K     ),FB)
                              ENDDO
                           ENDDO
                        END SELECT
                        IFACECUT = IFACECUT + 1
                        LOCATIONS(IFACECUT) = 1 + 16
                        FACES(3*IFACECUT-2:3*IFACECUT) = (/ IVERTCUT-3, IVERTCUT-2, IVERTCUT   /) ! Local Nodes 1, 2, 4

                        IFACECUT = IFACECUT + 1
                        LOCATIONS(IFACECUT) = 1 + 16
                        FACES(3*IFACECUT-2:3*IFACECUT) = (/ IVERTCUT  , IVERTCUT-1, IVERTCUT-3 /) ! Local Nodes 4, 3, 1
                     CASE(IBM_FTYPE_CFGAS)
                        ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                        IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                        X1AXIS  = CUT_FACE(ICF2)%IJK(KAXIS+1); DIR = X1AXIS
                        NVF     = CUT_FACE(ICF2)%CFELEM(1,IFACE2)
                        VERTBEG = IVERTCUT + 1
                        VERTBEG = 3*VERTBEG - 2
                        VERTEND = IVERTCUT + NVF
                        VERTEND = 3*VERTEND
                        DO IVCF=1,NVF
                           IVERTCUT = IVERTCUT + 1
                           IVERTCF=CUT_FACE(ICF2)%CFELEM(IVCF+1,IFACE2)
                           VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF2)%XYZVERT(1:3,IVERTCF),FB)
                        ENDDO
                        FACEBEG = 3*(IFACECUT+1) - 2
                        FACEEND = FACEBEG + 3*(NVF-2) - 1
                        FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                        VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                        VERT_OFFSET = IVERTCUT - NVF
                        ALLOCATE(LOCTYPE(NVF-2))
                        CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                        DO IVCF = 1, NVF-2 ! for now assume face is convex
                           IFACECUT = IFACECUT + 1
                           LOCATIONS(IFACECUT) = 2 + LOCTYPE(IVCF)
                           IF(IFACE2 > CUT_FACE(ICF2)%NFACE) LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Solid side.
                        ENDDO
                        DEALLOCATE(LOCTYPE)
                     CASE(IBM_FTYPE_CFINB)
                        ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                        IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                        NVF     = CUT_FACE(ICF2)%CFELEM(1,IFACE2); DIR = 0
                        VERTBEG = IVERTCUT + 1
                        VERTBEG = 3*VERTBEG - 2
                        VERTEND = IVERTCUT + NVF
                        VERTEND = 3*VERTEND
                        DO IVCF=1,NVF
                           IVERTCUT = IVERTCUT + 1
                           IVERTCF=CUT_FACE(ICF2)%CFELEM(IVCF+1,IFACE2)
                           VERTS(3*IVERTCUT-2:3*IVERTCUT) = REAL(CUT_FACE(ICF2)%XYZVERT(1:3,IVERTCF),FB)
                        ENDDO
                        FACEBEG = 3*(IFACECUT+1) - 2
                        FACEEND = FACEBEG + 3*(NVF-2) - 1
                        FACEPTR(1:3*(NVF-2))        =>FACES(FACEBEG:FACEEND)
                        VERTPTR(1:1+VERTEND-VERTBEG)=>VERTS(VERTBEG:VERTEND)
                        VERT_OFFSET = IVERTCUT - NVF
                        ALLOCATE(LOCTYPE(NVF-2))
                        CALL TRIANGULATE(DIR,VERTPTR,NVF,VERT_OFFSET,FACEPTR,LOCTYPE)
                        DO IVCF = 1, NVF-2 ! for now assume face is convex
                           IFACECUT = IFACECUT + 1
                           LOCATIONS(IFACECUT) = 1 + LOCTYPE(IVCF) ! Consider them as SOLID.
                        ENDDO
                        DEALLOCATE(LOCTYPE)
                     END SELECT
                  ENDDO
               ENDDO
            ENDDO
         ENDDO
      ENDDO
   ENDIF
END SUBROUTINE GET_GEOMINFO

! ---------------------------- GET_GEOMVALS ----------------------------------------

SUBROUTINE GET_GEOMVALS(NM,CC_FACE_CENTERED,CC_CELL_CENTERED,SLICETYPE, &
                        I1, I2, J1, J2, K1, K2,NFACES, NFACES_CUTCELLS, VALS,IND,Y_INDEX,Z_INDEX)
USE COMPLEX_GEOMETRY
USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION

! copy data from QQ array into VALS(1:NFACES)

INTEGER, INTENT(IN) :: NM, I1, I2, J1, J2, K1, K2, IND,Y_INDEX,Z_INDEX
INTEGER, INTENT(IN) :: NFACES, NFACES_CUTCELLS
CHARACTER(*), INTENT(IN) :: SLICETYPE
LOGICAL, INTENT(IN) :: CC_FACE_CENTERED,CC_CELL_CENTERED
REAL(FB), INTENT(OUT), DIMENSION(NFACES) :: VALS

INTEGER :: DIR, SLICE, IFACE
INTEGER :: I,J,K
CHARACTER(LEN=100) :: SLICETYPE_LOCAL
INTEGER :: CELLTYPE
INTEGER :: ICF, NVF, IFACECF, IVCF, IFACECUT

INTEGER :: X1AXIS, IEXIM, II, JJ, KK, ICC, JCC, NFC, ICCF, ICF2, IFACE2
REAL(EB):: VAL_CF

LOGICAL :: IS_RCFACE

SLICETYPE_LOCAL=TRIM(SLICETYPE) ! only generate CUTCELLS slice files if the immersed geometry option is turned on
IF (SLICETYPE=='INCLUDE_GEOM' .AND. .NOT.CC_IBM) SLICETYPE_LOCAL='IGNORE_GEOM'

CALL GETSLICEDIR(I1,I2,J1,J2,K1,K2,DIR,SLICE)
IF (SLICETYPE_LOCAL=='IGNORE_GEOM') THEN
   IFACE = 0
   IF (DIR==1) THEN
      DO K = K1+1, K2
         DO J = J1+1, J2
            IFACE = IFACE + 1
            VALS(IFACE) = QQ(SLICE,J,K,1)

            IFACE = IFACE + 1
            VALS(IFACE) = QQ(SLICE,J,K,1)
         END DO
      END DO
   ELSE IF (DIR==2) THEN
      DO K = K1+1, K2
         DO I = I1+1, I2
            IFACE = IFACE + 1
            VALS(IFACE) = QQ(I,SLICE,K,1)

            IFACE = IFACE + 1
            VALS(IFACE) = QQ(I,SLICE,K,1)
         END DO
      END DO
   ELSE
      DO J = J1+1, J2
         DO I = I1+1, I2
            IFACE = IFACE + 1
            VALS(IFACE) = QQ(I,J,SLICE,1)

            IFACE = IFACE + 1
            VALS(IFACE) = QQ(I,J,SLICE,1)
         END DO
      END DO
   ENDIF
ELSE IF (SLICETYPE_LOCAL=='INCLUDE_GEOM') THEN ! INTERP_C2F_FIELD
   X1AXIS = DIR
   IFACE = 0
   IFACECUT=NFACES-NFACES_CUTCELLS  ! start cutcell counter after 'regular' cells
   IF (DIR==1) THEN
      DO K = K1+1, K2
         DO J = J1+1, J2
            CELLTYPE = FCVAR(SLICE,J,K,IBM_FGSC,IAXIS)
            IF (CELLTYPE == IBM_CUTCFE) THEN
               ICF = FCVAR(SLICE,J,K,IBM_IDCF,IAXIS) ! is a cut cell
               DO IFACECF=1,CUT_FACE(ICF)%NFACE
                  CALL GET_GASCUTFACE_SCALAR_SLICE(X1AXIS,ICF,IFACECF,IND,CC_FACE_CENTERED,CC_CELL_CENTERED, &
                                                   Y_INDEX,Z_INDEX,VAL_CF)
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
               CALL GET_SOLIDCUTFACE_SCALAR_SLICE(X1AXIS,ICF,IND,Y_INDEX,Z_INDEX,VAL_CF)
               DO IFACECF=CUT_FACE(ICF)%NFACE+1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
            ELSEIF(CELLTYPE == IBM_SOLID) THEN
               CALL GET_SOLIDREGFACE_SCALAR_SLICE(X1AXIS,SLICE,J,K,IND,Y_INDEX,Z_INDEX,VAL_CF)
               IFACE = IFACE + 1  ! is a solid or gas cell
               VALS(IFACE) = REAL(VAL_CF,FB)

               IFACE = IFACE + 1
               VALS(IFACE) = REAL(VAL_CF,FB)
            ELSE
               ! Check if FACE is TYPE RC face:
               IS_RCFACE = (CCVAR(SLICE,J,K,IBM_CGSC)==IBM_CUTCFE) .OR. (CCVAR(SLICE+1,J,K,IBM_CGSC)==IBM_CUTCFE)
               IF (IS_RCFACE) THEN
                  ! TO DO: Place holder to interpolate Slice Variable to RCFACE:
                  ! ..
                  IFACE = IFACE + 1  ! is a gas cell
                  VALS(IFACE) = QQ(SLICE,J,K,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(SLICE,J,K,1)

               ELSE
                  IFACE = IFACE + 1  ! is a gas cell
                  VALS(IFACE) = QQ(SLICE,J,K,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(SLICE,J,K,1)
               ENDIF
            ENDIF
         END DO
      END DO
   ELSE IF (DIR==2) THEN
      DO K = K1+1, K2
         DO I = I1+1, I2
            CELLTYPE = FCVAR(I,SLICE,K,IBM_FGSC,JAXIS)
            IF (CELLTYPE == IBM_CUTCFE) THEN
               ICF = FCVAR(I,SLICE,K,IBM_IDCF,JAXIS)
               DO IFACECF=1,CUT_FACE(ICF)%NFACE
                  CALL GET_GASCUTFACE_SCALAR_SLICE(X1AXIS,ICF,IFACECF,IND,CC_FACE_CENTERED,CC_CELL_CENTERED, &
                                                   Y_INDEX,Z_INDEX,VAL_CF)
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
               CALL GET_SOLIDCUTFACE_SCALAR_SLICE(X1AXIS,ICF,IND,Y_INDEX,Z_INDEX,VAL_CF)
               DO IFACECF=CUT_FACE(ICF)%NFACE+1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
            ELSEIF(CELLTYPE == IBM_SOLID) THEN
               CALL GET_SOLIDREGFACE_SCALAR_SLICE(X1AXIS,I,SLICE,K,IND,Y_INDEX,Z_INDEX,VAL_CF)
               IFACE = IFACE + 1  ! is a solid or gas cell
               VALS(IFACE) = REAL(VAL_CF,FB)

               IFACE = IFACE + 1
               VALS(IFACE) = REAL(VAL_CF,FB)
            ELSE
               ! Check if FACE is TYPE RC face:
               IS_RCFACE = (CCVAR(I,SLICE,K,IBM_CGSC)==IBM_CUTCFE) .OR. (CCVAR(I,SLICE+1,K,IBM_CGSC)==IBM_CUTCFE)
               IF (IS_RCFACE) THEN
                  ! TO DO: Place holder to interpolate Slice Variable to RCFACE:
                  ! ..
                  IFACE = IFACE + 1  ! is a gas cell
                  VALS(IFACE) = QQ(I,SLICE,K,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,SLICE,K,1)
               ELSE
                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,SLICE,K,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,SLICE,K,1)
               ENDIF
            ENDIF
         END DO
      END DO
   ELSE
      DO J = J1+1, J2
         DO I = I1+1, I2
            CELLTYPE = FCVAR(I,J,SLICE,IBM_FGSC,KAXIS)
            IF (CELLTYPE == IBM_CUTCFE) THEN
               ICF = FCVAR(I,J,SLICE,IBM_IDCF,KAXIS)
               DO IFACECF=1,CUT_FACE(ICF)%NFACE
                  CALL GET_GASCUTFACE_SCALAR_SLICE(X1AXIS,ICF,IFACECF,IND,CC_FACE_CENTERED,CC_CELL_CENTERED, &
                                                   Y_INDEX,Z_INDEX,VAL_CF)
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
               CALL GET_SOLIDCUTFACE_SCALAR_SLICE(X1AXIS,ICF,IND,Y_INDEX,Z_INDEX,VAL_CF)
               DO IFACECF=CUT_FACE(ICF)%NFACE+1,CUT_FACE(ICF)%NFACE+CUT_FACE(ICF)%NSFACE
                  NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
                  DO IVCF = 1, NVF-2
                     IFACECUT = IFACECUT + 1
                     VALS(IFACECUT) = REAL(VAL_CF,FB)
                  ENDDO
               ENDDO
            ELSEIF(CELLTYPE == IBM_SOLID) THEN
               CALL GET_SOLIDREGFACE_SCALAR_SLICE(X1AXIS,I,J,SLICE,IND,Y_INDEX,Z_INDEX,VAL_CF)
               IFACE = IFACE + 1  ! is a solid or gas cell
               VALS(IFACE) = REAL(VAL_CF,FB)

               IFACE = IFACE + 1
               VALS(IFACE) = REAL(VAL_CF,FB)
            ELSE
               ! Check if FACE is TYPE RC face:
               IS_RCFACE = (CCVAR(I,J,SLICE,IBM_CGSC)==IBM_CUTCFE) .OR. (CCVAR(I,J,SLICE+1,IBM_CGSC)==IBM_CUTCFE)
               IF (IS_RCFACE) THEN
                  ! TO DO: Place holder to interpolate Slice Variable to RCFACE:
                  ! ..
                  IFACE = IFACE + 1  ! is a gas cell
                  VALS(IFACE) = QQ(I,J,SLICE,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,J,SLICE,1)
               ELSE
                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,J,SLICE,1)

                  IFACE = IFACE + 1
                  VALS(IFACE) = QQ(I,J,SLICE,1)
               ENDIF
            ENDIF
         END DO
      END DO
   ENDIF
ELSE IF (SLICETYPE_LOCAL=='INBOUND_FACES') THEN
   IFACECUT=NFACES-NFACES_CUTCELLS  ! start cutcell counter after 'regular' cells
   DO K=1,KBAR
      DO J=1,JBAR
         DO I=1,IBAR
         IF (CCVAR(I,J,K,IBM_IDCF) > 0) THEN
            ICF = CCVAR(I,J,K,IBM_IDCF)
            DO IFACECF=1,CUT_FACE(ICF)%NFACE
               VAL_CF = SOLID_PHASE_OUTPUT(NM,ABS(IND),Y_INDEX,Z_INDEX,-11, &
                                           OPT_CFACE_INDEX=CUT_FACE(ICF)%CFACE_INDEX(IFACECF))
               NVF=CUT_FACE(ICF)%CFELEM(1,IFACECF)
               DO IVCF = 1, NVF-2 ! face is convex
                  IFACECUT = IFACECUT + 1
                  VALS(IFACECUT) = REAL(VAL_CF,FB)
               ENDDO
            ENDDO
         ENDIF
         ENDDO
      ENDDO
   ENDDO
ELSE IF (SLICETYPE_LOCAL=='EXIMBND_FACES') THEN
   IFACECUT=NFACES-NFACES_CUTCELLS  ! start cutcell counter after 'regular' cells
   DO IEXIM=1,IBM_NEXIMFACE_MESH
      CALL GET_EXIMFACE_SCALAR_SLICE(IEXIM,IND,Y_INDEX,Z_INDEX,VAL_CF)
      DO IVCF = 1,2
         IFACECUT = IFACECUT + 1
         VALS(IFACECUT) = REAL(VAL_CF,FB)
      ENDDO
   ENDDO
ELSE IF (SLICETYPE_LOCAL=='CUT_CELLS') THEN
   IFACECUT=NFACES-NFACES_CUTCELLS
   VAL_CF=0._EB
   DO KK = 1, KBAR
      DO JJ = 1, JBAR
         DO II = 1, IBAR
            IF (CCVAR(II,JJ,KK,IBM_IDCC) <= 0) CYCLE
            ICC = CCVAR(II,JJ,KK,IBM_IDCC)
            DO JCC=1,CUT_CELL(ICC)%NCELL
               NFC=CUT_CELL(ICC)%CCELEM(1,JCC)
               ! Loop on faces corresponding to cut-cell ICC2:
               DO ICCF=1,NFC
                  IFACE=CUT_CELL(ICC)%CCELEM(ICCF+1,JCC)
                  SELECT CASE(CUT_CELL(ICC)%FACE_LIST(1,IFACE))
                  CASE(IBM_FTYPE_RGGAS) ! REGULAR GASPHASE
                     DO IVCF = 1,2
                        IFACECUT = IFACECUT + 1
                        VALS(IFACECUT) = REAL(VAL_CF,FB)
                     ENDDO

                  CASE(IBM_FTYPE_CFGAS)
                     ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                     IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                     NVF     = CUT_FACE(ICF2)%CFELEM(1,IFACE2)
                     DO IVCF = 1, NVF-2 ! for now assume face is convex
                        IFACECUT = IFACECUT + 1
                        VALS(IFACECUT) = REAL(VAL_CF,FB)
                     ENDDO

                  CASE(IBM_FTYPE_CFINB)
                     ICF2    = CUT_CELL(ICC)%FACE_LIST(4,IFACE)
                     IFACE2  = CUT_CELL(ICC)%FACE_LIST(5,IFACE)
                     NVF     = CUT_FACE(ICF2)%CFELEM(1,IFACE2); DIR = 0
                     DO IVCF = 1, NVF-2 ! face is convex
                        IFACECUT = IFACECUT + 1
                        VALS(IFACECUT) = REAL(VAL_CF,FB)
                     ENDDO

                  END SELECT
               ENDDO
            ENDDO
         ENDDO
      ENDDO
   ENDDO
ENDIF

END SUBROUTINE GET_GEOMVALS

! ---------------------------- DUMP_SLICE_GEOM ----------------------------------------

SUBROUTINE DUMP_SLICE_GEOM(FUNIT,SLICETYPE,HEADER,STIME,I1,I2,J1,J2,K1,K2)
CHARACTER(*), INTENT(IN) :: SLICETYPE
INTEGER, INTENT(IN) :: FUNIT, HEADER, I1, I2, J1, J2, K1, K2
REAL(FB) :: STIME

INTEGER :: I
INTEGER, PARAMETER :: ONE_INTEGER=1, ZERO_INTEGER=0, FIRST_FRAME_STATIC=1, NVOLS=0, VERSION=2
INTEGER :: NVERTS, NVERTS_CUTCELLS, NFACES, NFACES_CUTCELLS
REAL(FB), PARAMETER :: ZERO_FLOAT=0.0_FB
REAL(FB), ALLOCATABLE, DIMENSION(:) :: VERTS
INTEGER, ALLOCATABLE, DIMENSION(:) :: FACES, LOCATIONS

CALL GET_GEOMSIZES(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS)
IF (NVERTS>0 .AND. NFACES>0) THEN
   ALLOCATE(VERTS(3*NVERTS))
   ALLOCATE(FACES(3*NFACES))
   ALLOCATE(LOCATIONS(NFACES))
   CALL GET_GEOMINFO(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS,VERTS,FACES,LOCATIONS)
ELSE
   NVERTS=0
   NFACES=0
ENDIF

IF (HEADER==1) THEN
   WRITE(FUNIT) ONE_INTEGER
   WRITE(FUNIT) VERSION
   WRITE(FUNIT) ZERO_INTEGER, ZERO_INTEGER, FIRST_FRAME_STATIC
ENDIF
WRITE(FUNIT) STIME
WRITE(FUNIT) NVERTS, NFACES, NVOLS

IF (NVERTS>0 .AND. NFACES>0) THEN
   WRITE(FUNIT) (VERTS(I),I=1,3*NVERTS)
   WRITE(FUNIT) (FACES(I),I=1,3*NFACES)
   WRITE(FUNIT) (LOCATIONS(I),I=1,NFACES)   ! placeholders for now
   WRITE(FUNIT) (ZERO_FLOAT,ZERO_FLOAT,   I=1,3*NFACES) ! placeholders for now
ENDIF

WRITE(FUNIT) ZERO_FLOAT
WRITE(FUNIT) ZERO_INTEGER, ZERO_INTEGER, ZERO_INTEGER
IF (NVERTS>0 .AND. NFACES>0) THEN
      DEALLOCATE(VERTS)
      DEALLOCATE(FACES)
      DEALLOCATE(LOCATIONS)
ENDIF
END SUBROUTINE DUMP_SLICE_GEOM

! ---------------------------- DUMP_SLICE_GEOM_DATA ----------------------------------------

SUBROUTINE DUMP_SLICE_GEOM_DATA(NM,FUNIT,CC_FACE_CENTERED,CC_CELL_CENTERED,SLICETYPE, &
                                HEADER,STIME,I1,I2,J1,J2,K1,K2,IND,Y_INDEX,Z_INDEX,DEBUG)
CHARACTER(*), INTENT(IN) :: SLICETYPE
INTEGER, INTENT(IN) :: NM, FUNIT, HEADER, I1, I2, J1, J2, K1, K2, IND, Y_INDEX, Z_INDEX, DEBUG
REAL(FB), INTENT(IN):: STIME
LOGICAL, INTENT(IN) :: CC_FACE_CENTERED,CC_CELL_CENTERED

INTEGER, PARAMETER :: ONE_INTEGER=1, ZERO_INTEGER=0, VERSION=2
INTEGER :: NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS
INTEGER I
REAL(FB), ALLOCATABLE, DIMENSION(:) :: VALS

CALL GET_GEOMSIZES(SLICETYPE,I1,I2,J1,J2,K1,K2,NVERTS,NVERTS_CUTCELLS,NFACES,NFACES_CUTCELLS)
IF (NVERTS>0 .AND. NFACES>0) THEN
   ALLOCATE(VALS(NFACES))
   CALL GET_GEOMVALS(NM,CC_FACE_CENTERED,CC_CELL_CENTERED,SLICETYPE, &
                     I1, I2, J1, J2, K1, K2,NFACES,NFACES_CUTCELLS,VALS,IND,Y_INDEX,Z_INDEX)
ELSE
   NVERTS=0
   NFACES=0
ENDIF

IF (HEADER==1) THEN
   WRITE(FUNIT) ONE_INTEGER
   WRITE(FUNIT) VERSION
ENDIF
WRITE(FUNIT) STIME
WRITE(FUNIT) ZERO_INTEGER, ZERO_INTEGER, ZERO_INTEGER, NFACES
IF (NVERTS>0 .AND. NFACES>0) THEN
   IF (DEBUG .EQ. 0) THEN
      WRITE(FUNIT) (VALS(I),I=1,NFACES)
   ELSE
      WRITE(FUNIT) (REAL(100*NM,FB),I=1,NFACES)
   ENDIF
   DEALLOCATE(VALS)
ENDIF

END SUBROUTINE


SUBROUTINE DUMP_SLCF(T,DT,NM,IFRMT)

! Write either Slice (IFRMT=0) or Plot3D (IFRMT=1) or 3D slice (IFRMT=2) to a file

USE MEMORY_FUNCTIONS, ONLY: RE_ALLOCATE_STRINGS
USE GEOMETRY_FUNCTIONS, ONLY: SEARCH_OTHER_MESHES
USE TRAN, ONLY : GET_IJK
INTEGER, INTENT(IN) :: NM,IFRMT
REAL(EB), INTENT(IN) :: T,DT
REAL(EB) :: BSUM,TT
INTEGER :: I,J,K,NQT,I1,I2,J1,J2,K1,K2,ITM,ITM1,IQ,IQQ,IND,IND2,II1,II2,JJ1,JJ2,KK1,KK2, &
           IC,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX,NOM,IIO,JJO,KKO
INTEGER :: KTS,NTSL
REAL(EB), POINTER, DIMENSION(:,:,:) :: B,S,QUANTITY
INTEGER, POINTER, DIMENSION(:,:,:) :: C
REAL(FB) :: ZERO,STIME
LOGICAL :: PLOT3D,SLCF3D
LOGICAL :: AGL_TERRAIN_SLICE,CC_CELL_CENTERED,CC_FACE_CENTERED

! Return if there are no slices to process and this is not a Plot3D dump

DRY=.FALSE.

SELECT CASE(IFRMT)
   CASE(0) ; PLOT3D=.FALSE. ; SLCF3D=.FALSE.
   CASE(1) ; PLOT3D=.TRUE.  ; SLCF3D=.FALSE.
   CASE(2) ; PLOT3D=.FALSE. ; SLCF3D=.TRUE.
END SELECT

IF (MESHES(NM)%N_SLCF==0 .AND. .NOT.PLOT3D) RETURN

CALL POINT_TO_MESH(NM)

! Create an array, C, that is 1 at cell faces (I,J,K) for which U, V, and W are defined and 0 otherwise.

C => IWORK1
C = 0
DO K=0,KBP1
   DO J=0,JBP1
      DO I=0,IBP1
         IC = CELL_INDEX(I,J,K)
         IF (SOLID(IC) .OR. EXTERIOR(IC)) C(I,J,K) = 1
      ENDDO
   ENDDO
ENDDO

! Create an array, B, that is 1 in any cell that is to be included in the 8-cell corner average, 0 otherwise.

B => WORK1
B = 1._EB

DO IC=1,CELL_COUNT(NM)
   IF (SOLID(IC)) B(I_CELL(IC),J_CELL(IC),K_CELL(IC)) = 0._EB
   IF (EXTERIOR(IC)) THEN
      CALL SEARCH_OTHER_MESHES(XC(I_CELL(IC)),YC(J_CELL(IC)),ZC(K_CELL(IC)),NOM,IIO,JJO,KKO)
      IF (NOM==0) B(I_CELL(IC),J_CELL(IC),K_CELL(IC)) = 0._EB
   ENDIF
ENDDO

! Create an array, S, that is the reciprocal of the sum of the B values at cell corner (I,J,K).

S => WORK2
S = 0._EB

DO K=0,KBAR
   DO J=0,JBAR
      DO I=0,IBAR
         BSUM = B(I,J,K)+B(I+1,J+1,K+1)+B(I+1,J,K)+B(I,J+1,K)+B(I,J,K+1)+B(I+1,J+1,K)+B(I+1,J,K+1)+B(I,J+1,K+1)
         IF (BSUM>0._EB) S(I,J,K) = 1._EB/BSUM
      ENDDO
   ENDDO
ENDDO

! If sprinkler diagnostic on, pre-compute various PARTICLE flux output

IF (.NOT.PLOT3D) THEN
   IF (SLCF_PARTICLE_FLUX .AND. .NOT.EVACUATION_ONLY(NM)) CALL COMPUTE_PARTICLE_FLUXES(NM)
ELSE
   IF (PL3D_PARTICLE_FLUX .AND. .NOT.EVACUATION_ONLY(NM)) CALL COMPUTE_PARTICLE_FLUXES(NM)
ENDIF

! Determine slice or Plot3D indicies

QUANTITY=>WORK7

IF (PLOT3D) THEN  ! Write out information to .smv file
   TT   = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
   ITM  = INT(TT)
   ITM1 = INT(ABS(TT-ITM)*100)
   IF (ITM <0 ) THEN
      WRITE(FN_PL3D(NM),'(A,A,I4.4,A1,I8.7,A,I2.2,A2)') TRIM(CHID),'_',NM,'_',ITM,'_',ITM1,'.q'
   ELSE
      WRITE(FN_PL3D(NM),'(A,A,I4.4,A1,I8.8,A,I2.2,A2)') TRIM(CHID),'_',NM,'_',ITM,'_',ITM1,'.q'
   ENDIF
   IF (N_STRINGS+17>N_STRINGS_MAX) THEN
      CALL RE_ALLOCATE_STRINGS(NM)
      STRING => MESHES(NM)%STRING
   ENDIF
   N_STRINGS = N_STRINGS + 1
   WRITE(STRING(N_STRINGS),'(A,I5,A,I2.2,I6)')  'PL3D ',ITM,'.',ITM1,NM
   N_STRINGS = N_STRINGS + 1
   WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(FN_PL3D(NM))
   DO IQ=1,5
      N_STRINGS = N_STRINGS + 1
      WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(PLOT3D_SMOKEVIEW_LABEL(IQ))
      N_STRINGS = N_STRINGS + 1
      WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(PLOT3D_SMOKEVIEW_BAR_LABEL(IQ))
      N_STRINGS = N_STRINGS + 1
      WRITE(STRING(N_STRINGS),'(1X,A)') TRIM(OUTPUT_QUANTITY(PLOT3D_QUANTITY_INDEX(IQ))%UNITS)
   ENDDO
   OPEN(LU_PL3D(NM),FILE=FN_PL3D(NM),FORM='UNFORMATTED',STATUS='REPLACE')
ENDIF

! Loop through all the slice files or the 5 Plot3D quantities

IF (PLOT3D) THEN
   NQT = 5
ELSE
   NQT = N_SLCF
ENDIF

NTSL = 0

QUANTITY_LOOP: DO IQ=1,NQT

   IF (PLOT3D) THEN
      IND = PLOT3D_QUANTITY_INDEX(IQ)
      Y_INDEX = PLOT3D_Y_INDEX(IQ)
      Z_INDEX = PLOT3D_Z_INDEX(IQ)
      PART_INDEX = PLOT3D_PART_INDEX(IQ)
      VELO_INDEX = PLOT3D_VELO_INDEX(IQ)
      PROP_INDEX = 0
      I1  = 0
      I2  = IBAR
      J1  = 0
      J2  = JBAR
      K1  = 0
      K2  = KBAR
      AGL_TERRAIN_SLICE = .FALSE.
      CC_CELL_CENTERED = .FALSE.
      CC_FACE_CENTERED = .FALSE.
   ELSE
      SL => SLICE(IQ)
      IND  = SL%INDEX
      IND2 = SL%INDEX2
      Y_INDEX = SL%Y_INDEX
      Z_INDEX = SL%Z_INDEX
      PART_INDEX = SL%PART_INDEX
      VELO_INDEX = SL%VELO_INDEX
      PROP_INDEX = SL%PROP_INDEX
      REAC_INDEX = SL%REAC_INDEX
      MATL_INDEX = SL%MATL_INDEX
      I1  = SL%I1
      I2  = SL%I2
      J1  = SL%J1
      J2  = SL%J2
      K1  = SL%K1
      K2  = SL%K2
      AGL_TERRAIN_SLICE = SL%TERRAIN_SLICE
      CC_CELL_CENTERED = SL%CELL_CENTERED
      CC_FACE_CENTERED = SL%FACE_CENTERED
      IF ((I2-I1>0 .AND. J2-J1>0 .AND. K2-K1>0)  .AND. .NOT.SLCF3D) CYCLE QUANTITY_LOOP
      IF ((I2-I1==0 .OR. J2-J1==0 .OR. K2-K1==0) .AND.      SLCF3D) CYCLE QUANTITY_LOOP
   ENDIF

   ! Determine what cells need to be evaluated to form cell-corner averages

   II1 = I1
   II2 = I2+1
   JJ1 = J1
   JJ2 = J2+1
   KK1 = K1
   KK2 = K2+1

   SELECT CASE(OUTPUT_QUANTITY(IND)%CELL_POSITION)
      CASE(CELL_FACE)
         IF (OUTPUT_QUANTITY(IND)%IOR==1) II2 = I2
         IF (OUTPUT_QUANTITY(IND)%IOR==2) JJ2 = J2
         IF (OUTPUT_QUANTITY(IND)%IOR==3) KK2 = K2
      CASE(CELL_EDGE)
         II2 = I2
         JJ2 = J2
         KK2 = K2
   END SELECT

   ! Loop through the necessary cells, storing the desired output QUANTITY

   IF (.NOT.AGL_TERRAIN_SLICE) THEN
      DO K=KK1,KK2
         DO J=JJ1,JJ2
            DO I=II1,II2
               QUANTITY(I,J,K) = GAS_PHASE_OUTPUT(I,J,K,IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,PROP_INDEX,REAC_INDEX,&
                                                  MATL_INDEX,T,DT,NM)
            ENDDO
         ENDDO
      ENDDO
   ELSE
      NTSL = NTSL + 1
      DO I=II1,II2
         DO J=JJ1,JJ2
            DO K=KK1,KK2
               KTS = K_AGL_SLICE(I,J,NTSL)
               QUANTITY(I,J,K) = GAS_PHASE_OUTPUT(I,J,KTS,IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,T,DT,NM)
            ENDDO
         ENDDO
      ENDDO
   ENDIF

   ! Average the QUANTITY at cell nodes, faces, or edges, as appropriate

   IF (PLOT3D) THEN
      IQQ = IQ
   ELSE
      IQQ = 1
   ENDIF

   IF (.NOT.AGL_TERRAIN_SLICE .AND. .NOT.CC_CELL_CENTERED .AND. .NOT.CC_FACE_CENTERED) THEN

   ! node centered slice

   DO K=K1,K2
      DO J=J1,J2
         DO I=I1,I2
            SELECT CASE(OUTPUT_QUANTITY(IND)%CELL_POSITION)
               CASE(CELL_CENTER)
                  QQ(I,J,K,IQQ) = REAL(CORNER_VALUE(QUANTITY,B,S,IND),FB)
               CASE(CELL_FACE)
                  QQ(I,J,K,IQQ) = REAL(FACE_VALUE(),FB)
               CASE(CELL_EDGE)
                  QQ(I,J,K,IQQ) = REAL(EDGE_VALUE(QUANTITY,S,IND),FB)
            END SELECT
         ENDDO
      ENDDO
   ENDDO

   !  or cell centered or terrain-following (treated as cell centered) slice

   ELSE IF (AGL_TERRAIN_SLICE .OR. CC_CELL_CENTERED) THEN
      DO K=KK1,KK2
         DO J=JJ1,JJ2
            DO I=II1,II2
               QQ(I,J,K,IQQ) = REAL(QUANTITY(I,J,K),FB)
            ENDDO
         ENDDO
      ENDDO

   ELSE

   ! face centered slice

      DO K=KK1,KK2
         DO J=JJ1,JJ2
            DO I=II1,II2
            !xxx need to change the following code to use face centered interpolation
            ! (perhaps copy some variant of node centered interpolation code above)
               QQ(I,J,K,IQQ) = REAL(QUANTITY(I,J,K),FB)
            ENDDO
         ENDDO
      ENDDO
   ENDIF

   ! Dump out the slice file to a .sf file

   IF (.NOT.PLOT3D) THEN
      SL => SLICE(IQ)
      IF (SL%SLICETYPE=='STRUCTURED') THEN ! write out slice file using original slice file format
         STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
         OPEN(LU_SLCF(IQ,NM),FILE=FN_SLCF(IQ,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
         WRITE(LU_SLCF(IQ,NM)) STIME
         WRITE(LU_SLCF(IQ,NM)) (((QQ(I,J,K,1),I=I1,I2),J=J1,J2),K=K1,K2)
         CLOSE(LU_SLCF(IQ,NM))
      ELSE
         STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
         ! write geometry for slice file
         IF (ABS(STIME-T_BEGIN)<TWO_EPSILON_EB) THEN
         ! geometry and data file at first time step
            OPEN(LU_SLCF_GEOM(IQ,NM),FILE=FN_SLCF_GEOM(IQ,NM),FORM='UNFORMATTED',STATUS='REPLACE')
            CALL DUMP_SLICE_GEOM(LU_SLCF_GEOM(IQ,NM),SL%SLICETYPE,1,STIME,I1,I2,J1,J2,K1,K2)
            CLOSE(LU_SLCF_GEOM(IQ,NM))

            OPEN(LU_SLCF(IQ,NM),FILE=FN_SLCF(IQ,NM),FORM='UNFORMATTED',STATUS='REPLACE')
            CALL DUMP_SLICE_GEOM_DATA(NM,LU_SLCF(IQ,NM),SL%FACE_CENTERED,SL%CELL_CENTERED,SL%SLICETYPE, &
                                      1,STIME,I1,I2,J1,J2,K1,K2,IND,Y_INDEX,Z_INDEX,0)
            CLOSE(LU_SLCF(IQ,NM))
         ELSE
         ! data file at subsequent time steps
            OPEN(LU_SLCF(IQ,NM),FILE=FN_SLCF(IQ,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
            CALL DUMP_SLICE_GEOM_DATA(NM,LU_SLCF(IQ,NM),SL%FACE_CENTERED,SL%CELL_CENTERED,SL%SLICETYPE, &
                                      0,STIME,I1,I2,J1,J2,K1,K2,IND,Y_INDEX,Z_INDEX,0)
            CLOSE(LU_SLCF(IQ,NM))
         ENDIF
      ENDIF
   ENDIF

ENDDO QUANTITY_LOOP

! Write out the PLOT3D ``q'' file

IF (PLOT3D) THEN
   ZERO = 0._EB
   WRITE(LU_PL3D(NM)) IBP1,JBP1,KBP1
   WRITE(LU_PL3D(NM)) ZERO,ZERO,ZERO,ZERO
   WRITE(LU_PL3D(NM)) ((((QQ(I,J,K,IQ),I=0,IBAR),J=0,JBAR),K=0,KBAR),IQ=1,5)
   CLOSE(LU_PL3D(NM))
ENDIF

CONTAINS


REAL(EB) FUNCTION CORNER_VALUE(A,B,S,INDX)

REAL(EB), INTENT(IN), DIMENSION(0:,0:,0:) :: A,B,S
INTEGER, INTENT(IN) :: INDX

IF (ABS(S(I,J,K))<=TWO_EPSILON_EB) THEN
   CORNER_VALUE = OUTPUT_QUANTITY(INDX)%AMBIENT_VALUE
ELSE
   CORNER_VALUE = S(I,J,K)*(A(I,J,K)    *B(I,J,K)     + A(I+1,J,K)    *B(I+1,J,K)   + &
                            A(I,J,K+1)  *B(I,J,K+1)   + A(I+1,J,K+1)  *B(I+1,J,K+1) + &
                            A(I,J+1,K)  *B(I,J+1,K)   + A(I+1,J+1,K)  *B(I+1,J+1,K) + &
                            A(I,J+1,K+1)*B(I,J+1,K+1) + A(I+1,J+1,K+1)*B(I+1,J+1,K+1))
ENDIF

END FUNCTION CORNER_VALUE


REAL(EB) FUNCTION FACE_VALUE()

REAL(EB) :: AA(0:1,0:1),WGT(0:1,0:1)
INTEGER :: II,JJ,KK,IIM,JJM,KKM,ICX,ICY,ICZ
LOGICAL :: SET(0:1,0:1)

SELECT CASE(OUTPUT_QUANTITY(IND)%IOR)
   CASE(1) ; AA(0:1,0:1) = QUANTITY(I,J:J+1,K:K+1)
   CASE(2) ; AA(0:1,0:1) = QUANTITY(I:I+1,J,K:K+1)
   CASE(3) ; AA(0:1,0:1) = QUANTITY(I:I+1,J:J+1,K)
END SELECT
WGT  = 0.25_EB
IC = CELL_INDEX(I,J,K)
IF (IC>0) THEN
   SET = .FALSE.
   SELECT CASE(IND)
      CASE(6)
         DO KK=0,1
            DO JJ=0,1
               IF (C(I,J+JJ,K+KK)==1 .AND.  C(I+1,J+JJ,K+KK)==1) THEN
                  JJM = MOD(JJ+1,2)
                  KKM = MOD(KK+1,2)
                  ICY = CELL_INDEX(I,J,K+KK)
                  ICZ = CELL_INDEX(I,J+JJ,K)
                  IF (U_EDGE_Y(ICY)>-1.E5_EB .AND.  .NOT.SET(JJ,KK)) THEN
                     AA(JJ,KK) = 2._EB*U_EDGE_Y(ICY) - AA(JJM,KK)
                     SET(JJ,KK) = .TRUE.
                  ENDIF
                  IF (U_EDGE_Z(ICZ)>-1.E5_EB .AND.  .NOT.SET(JJ,KK)) THEN
                     AA(JJ,KK) = 2._EB*U_EDGE_Z(ICZ) - AA(JJ,KKM)
                     SET(JJ,KK) = .TRUE.
                  ENDIF
                  IF (.NOT.SET(JJ,KK)) WGT(JJ,KK) = 0._EB
               ENDIF
            ENDDO
         ENDDO
      CASE(7)
         DO KK=0,1
            DO II=0,1
               IF (C(I+II,J,K+KK)==1 .AND.  C(I+II,J+1,K+KK)==1) THEN
                  IIM = MOD(II+1,2)
                  KKM = MOD(KK+1,2)
                  ICX = CELL_INDEX(I,J,K+KK)
                  ICZ = CELL_INDEX(I+II,J,K)
                  IF (V_EDGE_X(ICX)>-1.E5_EB .AND.  .NOT.SET(II,KK)) THEN
                     AA(II,KK) = 2._EB*V_EDGE_X(ICX) - AA(IIM,KK)
                     SET(II,KK) = .TRUE.
                  ENDIF
                  IF (V_EDGE_Z(ICZ)>-1.E5_EB .AND.  .NOT.SET(II,KK)) THEN
                     AA(II,KK) = 2._EB*V_EDGE_Z(ICZ) - AA(II,KKM)
                     SET(II,KK) = .TRUE.
                  ENDIF
                  IF (.NOT.SET(II,KK)) WGT(II,KK) = 0._EB
               ENDIF
            ENDDO
         ENDDO
      CASE(8)
         DO JJ=0,1
            DO II=0,1
               IF (C(I+II,J+JJ,K)==1 .AND.  C(I+II,J+JJ,K+1)==1) THEN
                  IIM = MOD(II+1,2)
                  JJM = MOD(JJ+1,2)
                  ICX = CELL_INDEX(I,J+JJ,K)
                  ICY = CELL_INDEX(I+II,J,K)
                  IF (W_EDGE_X(ICX)>-1.E5_EB .AND.  .NOT.SET(II,JJ)) THEN
                     AA(II,JJ) = 2._EB*W_EDGE_X(ICX) - AA(IIM,JJ)
                     SET(II,JJ) = .TRUE.
                  ENDIF
                  IF (W_EDGE_Y(ICY)>-1.E5_EB .AND.  .NOT.SET(II,JJ)) THEN
                     AA(II,JJ) = 2._EB*W_EDGE_Y(ICY) - AA(II,JJM)
                     SET(II,JJ) = .TRUE.
                  ENDIF
                  IF (.NOT.SET(II,JJ)) WGT(II,JJ) = 0._EB
               ENDIF
            ENDDO
         ENDDO
   END SELECT
ENDIF
IF (SUM(WGT)>0._EB) THEN
   FACE_VALUE = SUM(AA*WGT)/SUM(WGT)
ELSE
   FACE_VALUE = OUTPUT_QUANTITY(IND)%AMBIENT_VALUE
ENDIF

END FUNCTION FACE_VALUE


REAL(EB) FUNCTION EDGE_VALUE(A,S,INDX)

REAL(EB), INTENT(IN), DIMENSION(0:,0:,0:) :: A,S
INTEGER, INTENT(IN) :: INDX

IF (ABS(S(I,J,K))<=TWO_EPSILON_EB) THEN
   EDGE_VALUE = OUTPUT_QUANTITY(INDX)%AMBIENT_VALUE
ELSE
   EDGE_VALUE = A(I,J,K)
ENDIF

END FUNCTION EDGE_VALUE

END SUBROUTINE DUMP_SLCF


SUBROUTINE UPDATE_DEVICES_1(T,DT,NM)

! Update the value of all sensing DEVICEs, any control function outputs, and associated output quantities

USE MEMORY_FUNCTIONS, ONLY : GET_LAGRANGIAN_PARTICLE_INDEX
USE COMPLEX_GEOMETRY, ONLY : IBM_CGSC, IBM_SOLID
REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: NM
REAL(EB) :: VALUE,VOL
INTEGER :: N,I,J,K,IW,SURF_INDEX,LP_INDEX,ICF

CALL POINT_TO_MESH(NM)

! If any device has QUANTITY='PARTICLE FLUX N', pre-compute PARTICLE fluxes

IF (DEVC_PARTICLE_FLUX .AND. .NOT.EVACUATION_ONLY(NM)) CALL COMPUTE_PARTICLE_FLUXES(NM)

! Loop over all devices, calculate quantity, and perform spatial averaging, min/max, etc.

DEVICE_LOOP: DO N=1,N_DEVC

   DV => DEVICE(N)

   IF (DV%N_SUBDEVICES==0) CYCLE DEVICE_LOOP
   IF (DV%SUBDEVICE_INDEX(NM)==0) CYCLE DEVICE_LOOP

   SDV => DV%SUBDEVICE(DV%SUBDEVICE_INDEX(NM))

   ! Check to see if the device is tied to an INIT line, in which case it is tied to a specific particle. Test to see if the
   ! particle is in the current mesh.

   LP_INDEX = 0
   IF (DV%INIT_ID/='null') THEN
      IF (DV%LP_TAG>0) THEN
         CALL GET_LAGRANGIAN_PARTICLE_INDEX(NM,DV%PART_CLASS_INDEX,DV%LP_TAG,LP_INDEX)
         IF (LP_INDEX==0) CYCLE DEVICE_LOOP
         IF (LP_INDEX>0)  SDV%MESH = NM
      ELSE
         CYCLE DEVICE_LOOP
      ENDIF
   ENDIF

   ! If the device is not in the current MESH, cycle

   IF (SDV%MESH/=NM) CYCLE DEVICE_LOOP

   ! Reset state variables so that if a change occurs due to a setpoint being reached, action can be taken

   DV%PRIOR_STATE = DV%CURRENT_STATE

   IF (DV%NO_UPDATE_DEVC_INDEX>0) THEN
      IF (DEVICE(DV%NO_UPDATE_DEVC_INDEX)%CURRENT_STATE) THEN
         SDV%VALUE_1 = DV%SMOOTHED_VALUE
         CYCLE DEVICE_LOOP
      ENDIF
   ELSEIF (DV%NO_UPDATE_CTRL_INDEX>0) THEN
      IF (CONTROL(DV%NO_UPDATE_CTRL_INDEX)%CURRENT_STATE) THEN
         SDV%VALUE_1 = DV%SMOOTHED_VALUE
         CYCLE DEVICE_LOOP
      ENDIF
   ENDIF

   DRY = DV%DRY
   PY => PROPERTY(DV%PROP_INDEX)

   ! Initial values for statistics

   SDV%VALUE_1 = 0._EB
   SDV%VALUE_2 = 0._EB
   IF (DV%TEMPORAL_STATISTIC=='MAX' .OR. DV%SPATIAL_STATISTIC=='MAX') SDV%VALUE_1 = -HUGE(0.0_EB) + 1.0_EB
   IF (DV%TEMPORAL_STATISTIC=='MIN' .OR. DV%SPATIAL_STATISTIC=='MIN') SDV%VALUE_1 =  HUGE(0.0_EB) - 1.0_EB

   ! Select hvac or gas phase or solid phase output quantity

   OUTPUT_INDEX_SELECT: SELECT CASE(DV%OUTPUT_INDEX)

      CASE(-1000:0) OUTPUT_INDEX_SELECT ! solid phase

         SOLID_STATS_SELECT: SELECT CASE(DV%SPATIAL_STATISTIC)

            CASE('null') SOLID_STATS_SELECT

               IF (DV%WALL_INDEX>0) THEN
                  SDV%VALUE_1 = SOLID_PHASE_OUTPUT(NM,ABS(DV%OUTPUT_INDEX),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                                                   OPT_WALL_INDEX=DV%WALL_INDEX)
               ELSEIF (DV%LP_TAG>0) THEN
                  SDV%VALUE_1 = SOLID_PHASE_OUTPUT(NM,ABS(DV%OUTPUT_INDEX),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                                                   OPT_LP_INDEX=LP_INDEX)
               ELSEIF (DV%CFACE_INDEX>0) THEN
                  SDV%VALUE_1 = SOLID_PHASE_OUTPUT(NM,ABS(DV%OUTPUT_INDEX),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                                                   OPT_CFACE_INDEX=DV%CFACE_INDEX)
               ENDIF

            CASE DEFAULT SOLID_STATS_SELECT

               WALL_CELL_LOOP: DO IW=1,N_EXTERNAL_WALL_CELLS+N_INTERNAL_WALL_CELLS
                  WC => WALL(IW)
                  SELECT CASE(WC%BOUNDARY_TYPE)
                     CASE(SOLID_BOUNDARY)
                     CASE(OPEN_BOUNDARY)
                     CASE DEFAULT
                        CYCLE WALL_CELL_LOOP
                  END SELECT
                  SURF_INDEX = WC%SURF_INDEX
                  IF (DV%IOR/=0 .AND. DV%IOR/=WC%ONE_D%IOR) CYCLE WALL_CELL_LOOP
                  IF (DV%SURF_ID/='null' .AND. SURFACE(SURF_INDEX)%ID/=DV%SURF_ID) CYCLE WALL_CELL_LOOP
                  IF (WC%X<SDV%X1-MICRON .OR. WC%X>SDV%X2+MICRON .OR. &
                      WC%Y<SDV%Y1-MICRON .OR. WC%Y>SDV%Y2+MICRON .OR. &
                      WC%Z<SDV%Z1-MICRON .OR. WC%Z>SDV%Z2+MICRON) CYCLE WALL_CELL_LOOP
                  VALUE = SOLID_PHASE_OUTPUT(NM,ABS(DV%OUTPUT_INDEX),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,OPT_WALL_INDEX=IW)
                  SELECT CASE(DV%SPATIAL_STATISTIC)
                     CASE('MAX')
                        SDV%VALUE_1 = MAX(SDV%VALUE_1,VALUE)
                     CASE('MIN')
                        SDV%VALUE_1 = MIN(SDV%VALUE_1,VALUE)
                     CASE('MEAN')
                        SDV%VALUE_1 = SDV%VALUE_1 + VALUE
                        SDV%VALUE_2 = SDV%VALUE_2 + 1._EB
                     CASE('SURFACE INTEGRAL')
                        IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                           SDV%VALUE_1 = SDV%VALUE_1 + VALUE*WC%ONE_D%AREA*WC%ONE_D%AREA_ADJUST
                     CASE('SURFACE AREA')
                        IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                           SDV%VALUE_1 = SDV%VALUE_1 + WC%ONE_D%AREA*WC%ONE_D%AREA_ADJUST
                  END SELECT
               ENDDO WALL_CELL_LOOP

               CFACE_LOOP : DO ICF=1,N_CFACE_CELLS
                  CFA => CFACE(ICF)
                  SELECT CASE(CFA%BOUNDARY_TYPE)
                     CASE(SOLID_BOUNDARY)
                     CASE(OPEN_BOUNDARY)
                     CASE DEFAULT
                        CYCLE CFACE_LOOP
                  END SELECT
                  SURF_INDEX = CFA%SURF_INDEX
                  ! IF (DV%IOR/=0 .AND. DV%IOR/=CFA%ONE_D%IOR) CYCLE CFACE_LOOP
                  IF (DV%SURF_ID/='null' .AND. SURFACE(SURF_INDEX)%ID/=DV%SURF_ID) CYCLE CFACE_LOOP
                  IF (CFA%X<SDV%X1-MICRON .OR. CFA%X>SDV%X2+MICRON .OR. &
                      CFA%Y<SDV%Y1-MICRON .OR. CFA%Y>SDV%Y2+MICRON .OR. &
                      CFA%Z<SDV%Z1-MICRON .OR. CFA%Z>SDV%Z2+MICRON) CYCLE CFACE_LOOP
                  VALUE = SOLID_PHASE_OUTPUT(NM,ABS(DV%OUTPUT_INDEX),DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                     OPT_CFACE_INDEX=ICF)
                  SELECT CASE(DV%SPATIAL_STATISTIC)
                     CASE('MAX')
                        SDV%VALUE_1 = MAX(SDV%VALUE_1,VALUE)
                     CASE('MIN')
                        SDV%VALUE_1 = MIN(SDV%VALUE_1,VALUE)
                     CASE('MEAN')
                        SDV%VALUE_1 = SDV%VALUE_1 + VALUE
                        SDV%VALUE_2 = SDV%VALUE_2 + 1._EB
                     CASE('SURFACE INTEGRAL')
                        IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                           SDV%VALUE_1 = SDV%VALUE_1 + VALUE*CFA%ONE_D%AREA*CFA%ONE_D%AREA_ADJUST
                     CASE('SURFACE AREA')
                        IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                           SDV%VALUE_1 = SDV%VALUE_1 + CFA%ONE_D%AREA
                  END SELECT

               ENDDO CFACE_LOOP

         END SELECT SOLID_STATS_SELECT

      CASE(1:299,500:N_OUTPUT_QUANTITIES) OUTPUT_INDEX_SELECT ! gas phase

         GAS_STATS_SELECT: SELECT CASE(DV%SPATIAL_STATISTIC)

            CASE('null') GAS_STATS_SELECT

               I = MIN( IBP1, MAX(0, DV%I + DV%GHOST_CELL_IOR(1) ) )
               J = MIN( JBP1, MAX(0, DV%J + DV%GHOST_CELL_IOR(2) ) )
               K = MIN( KBP1, MAX(0, DV%K + DV%GHOST_CELL_IOR(3) ) )
               SDV%VALUE_1 = GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,0,DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,DV%VELO_INDEX,&
                                              DV%PIPE_INDEX,DV%PROP_INDEX,DV%REAC_INDEX,DV%MATL_INDEX,T,DT,NM)

               IF (DV%OUTPUT2_INDEX>0) &
                  SDV%VALUE_2 = GAS_PHASE_OUTPUT(DV%I,DV%J,DV%K,DV%OUTPUT2_INDEX,0,DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,&
                                                 DV%VELO_INDEX,DV%PIPE_INDEX,DV%PROP_INDEX,DV%REAC_INDEX,DV%MATL_INDEX,T,DT,NM)

            CASE DEFAULT GAS_STATS_SELECT

               K_DEVICE_CELL_LOOP: DO K=SDV%K1,SDV%K2
                  J_DEVICE_CELL_LOOP: DO J=SDV%J1,SDV%J2
                     I_DEVICE_CELL_LOOP: DO I=SDV%I1,SDV%I2
                        IF (SOLID(CELL_INDEX(I,J,K))) THEN
                            OB => OBSTRUCTION(OBST_INDEX_C(CELL_INDEX(I,J,K)))
                            IF (.NOT.OB%HT3D) CYCLE I_DEVICE_CELL_LOOP
                        ENDIF
                        IF (CC_IBM) THEN
                            IF (CCVAR(I,J,K,IBM_CGSC) == IBM_SOLID) CYCLE I_DEVICE_CELL_LOOP
                        ENDIF
                        VOL = DX(I)*RC(I)*DY(J)*DZ(K)
                        VALUE = GAS_PHASE_OUTPUT(I,J,K,DV%OUTPUT_INDEX,0,DV%Y_INDEX,DV%Z_INDEX,DV%PART_CLASS_INDEX,DV%VELO_INDEX,&
                                                 DV%PIPE_INDEX,DV%PROP_INDEX,DV%REAC_INDEX,DV%MATL_INDEX,T,DT,NM)
                        STATISTICS_SELECT: SELECT CASE(DV%SPATIAL_STATISTIC)
                           CASE('MAX')
                              SDV%VALUE_1 = MAX(SDV%VALUE_1,VALUE)
                           CASE('MIN')
                              SDV%VALUE_1 = MIN(SDV%VALUE_1,VALUE)
                           CASE('MEAN')
                              SDV%VALUE_1 = SDV%VALUE_1 + VALUE
                              SDV%VALUE_2 = SDV%VALUE_2 + 1._EB
                           CASE('VOLUME INTEGRAL')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                                 SDV%VALUE_1 = SDV%VALUE_1 + VALUE*VOL
                           CASE('MASS INTEGRAL')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                                 SDV%VALUE_1 = SDV%VALUE_1 + VALUE*VOL*RHO(I,J,K)
                           CASE('AREA INTEGRAL')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) THEN
                                 SELECT CASE (ABS(DV%IOR_ASSUMED))
                                    CASE(1)
                                       SDV%VALUE_1 = SDV%VALUE_1 + RC(I)*DY(J)*DZ(K)*VALUE
                                    CASE(2)
                                       SDV%VALUE_1 = SDV%VALUE_1 + DX(I)*DZ(K)*VALUE
                                    CASE(3)
                                       SDV%VALUE_1 = SDV%VALUE_1 + DX(I)*RC(I)*DY(J)*VALUE
                                    END SELECT
                              ENDIF
                           CASE('AREA')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) THEN
                                 SELECT CASE (ABS(DV%IOR_ASSUMED))
                                    CASE(1)
                                       SDV%VALUE_1 = SDV%VALUE_1 + RC(I)*DY(J)*DZ(K)
                                    CASE(2)
                                       SDV%VALUE_1 = SDV%VALUE_1 + DX(I)*DZ(K)
                                    CASE(3)
                                       SDV%VALUE_1 = SDV%VALUE_1 + DX(I)*RC(I)*DY(J)
                                    END SELECT
                              ENDIF
                           CASE('VOLUME')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                                 SDV%VALUE_1 = SDV%VALUE_1 + VOL
                           CASE('MASS')
                              IF (VALUE <= DV%QUANTITY_RANGE(2) .AND. VALUE >=DV%QUANTITY_RANGE(1)) &
                                 SDV%VALUE_1 = SDV%VALUE_1 + VOL*RHO(I,J,K)
                           CASE('VOLUME MEAN')
                              SDV%VALUE_1 = SDV%VALUE_1 + VALUE*VOL
                              SDV%VALUE_2 = SDV%VALUE_2 + VOL
                           CASE('MASS MEAN')
                              SDV%VALUE_1 = SDV%VALUE_1 + VALUE*RHO(I,J,K)*VOL
                              SDV%VALUE_2 = SDV%VALUE_2 + VOL*RHO(I,J,K)
                     END SELECT STATISTICS_SELECT
                  ENDDO I_DEVICE_CELL_LOOP
               ENDDO J_DEVICE_CELL_LOOP
            ENDDO K_DEVICE_CELL_LOOP

         END SELECT GAS_STATS_SELECT

      CASE(300:350) OUTPUT_INDEX_SELECT  ! HVAC output

         SDV%VALUE_1 = HVAC_OUTPUT(DV%OUTPUT_INDEX,DV%Y_INDEX,DV%Z_INDEX,DV%DUCT_INDEX,DV%NODE_INDEX,DV%DUCT_CELL_INDEX)

      CASE(400:450) OUTPUT_INDEX_SELECT  ! Particle-specific output

         IF (LP_INDEX>0) SDV%VALUE_1 = PARTICLE_OUTPUT(T,ABS(DV%OUTPUT_INDEX),LP_INDEX)

   END SELECT OUTPUT_INDEX_SELECT

ENDDO DEVICE_LOOP

END SUBROUTINE UPDATE_DEVICES_1


SUBROUTINE UPDATE_DEVICES_2(T,DT)

! Perform temporal operations on the DEViCes

USE MPI
REAL(EB), INTENT(IN) :: T,DT
REAL(EB) :: WGT,WGT_UNBIASED
INTEGER :: N,IERR,INTERVAL_INDEX

DEVICE_LOOP: DO N=1,N_DEVC

   DV => DEVICE(N)

   ! Zero out VALUE of the device before the temporal window

   IF (T<DV%STATISTICS_START) THEN
      DV%VALUE = 0._EB
      DV%TIME_INTERVAL = 1._EB
      CYCLE DEVICE_LOOP
   ENDIF

   ! Freeze current VALUE and TIME_INTERVAL for a device beyond the temporal window

   IF (T>DV%STATISTICS_END) CYCLE DEVICE_LOOP

   ! Update DEViCe values

   SELECT CASE (DV%SPATIAL_STATISTIC)
      CASE DEFAULT
         DV%INSTANT_VALUE = DV%VALUE_1
      CASE('MASS MEAN','VOLUME MEAN','MEAN')
         DV%INSTANT_VALUE = DV%VALUE_1 / DV%VALUE_2
   END SELECT

   ! Special spacially-integrated devices

   IF (DV%QUANTITY=='TRANSMISSION')     DV%INSTANT_VALUE = EXP(-DV%VALUE_1/DV%VALUE_2)*100._EB
   IF (DV%QUANTITY=='PATH OBSCURATION') DV%INSTANT_VALUE = (1._EB-EXP(-DV%VALUE_1))*100._EB

   IF (DV%QUANTITY=='LAYER HEIGHT' .OR. DV%QUANTITY=='UPPER TEMPERATURE' .OR. DV%QUANTITY=='LOWER TEMPERATURE') THEN
      IF (N_MPI_PROCESSES>1) CALL MPI_BCAST(DV%TMP_LOW,1,MPI_DOUBLE_PRECISION,PROCESS(DV%LOWEST_MESH),MPI_COMM_WORLD,IERR)
      IF (ABS(DV%VALUE_3)<=TWO_EPSILON_EB) THEN  ! VALUE_3 is int_Z_INT^H T(z) dz
         DV%TMP_UP = DV%TMP_LOW
      ELSE
         DV%TMP_UP = DV%VALUE_3/(DV%Z2-DV%Z1-DV%Z_INT)  ! This is Z_INT from previous time step
      ENDIF
      DV%Z_INT   = (DV%VALUE_1+DV%VALUE_2*DV%TMP_LOW**2-2._EB*DV%TMP_LOW*(DV%Z2-DV%Z1))
      IF (ABS(DV%Z_INT)<=TWO_EPSILON_EB) THEN
         DV%Z_INT = DV%Z2-DV%Z1
      ELSE
         DV%Z_INT = DV%TMP_LOW*(DV%VALUE_1*DV%VALUE_2-(DV%Z2-DV%Z1)**2)/DV%Z_INT
      ENDIF
      IF (DV%QUANTITY=='LAYER HEIGHT')      DV%INSTANT_VALUE = DV%Z_INT
      IF (DV%QUANTITY=='UPPER TEMPERATURE') DV%INSTANT_VALUE = DV%TMP_UP  - TMPM
      IF (DV%QUANTITY=='LOWER TEMPERATURE') DV%INSTANT_VALUE = DV%TMP_LOW - TMPM
   ENDIF

   ! Optional absolute value

   IF (DV%ABSOLUTE_VALUE) DV%INSTANT_VALUE = ABS(DV%INSTANT_VALUE)

   ! Convert units of device quantity

   DV%INSTANT_VALUE = DV%CONVERSION_FACTOR*DV%INSTANT_VALUE + DV%CONVERSION_ADDEND

   ! Record initial value and then subtract from computed value

   IF (DV%INITIAL_VALUE<-1.E9_EB) THEN
      IF (DV%RELATIVE) THEN
         DV%INITIAL_VALUE = DV%INSTANT_VALUE
      ELSE
         DV%INITIAL_VALUE = 0._EB
      ENDIF
   ENDIF
   DV%INSTANT_VALUE = DV%INSTANT_VALUE - DV%INITIAL_VALUE

   ! Create a smoothed output

   IF (DV%SMOOTHED_VALUE < -1.E9_EB) DV%SMOOTHED_VALUE = DV%INSTANT_VALUE
   DV%SMOOTHED_VALUE = DV%SMOOTHED_VALUE*DV%SMOOTHING_FACTOR + DV%VALUE_1*(1._EB-DV%SMOOTHING_FACTOR)

   ! Do not start summing time devices if this is the start of the simulation

   IF (T==T_BEGIN) THEN
      DV%TIME_INTERVAL = 1._EB
      DV%VALUE = DV%INSTANT_VALUE
      IF (DV%TEMPORAL_STATISTIC=='TIME INTEGRAL') DV%VALUE = 0._EB
      CYCLE DEVICE_LOOP
   ENDIF

   ! Weight factor for time-averaging

   WGT = DT/MAX(DT,T-DV%STATISTICS_START)
   DV%AVERAGE_VALUE = (1._EB-WGT)*DV%AVERAGE_VALUE  + WGT*DV%INSTANT_VALUE

   ! Apply the various temporal statistics

   SELECT CASE (DV%TEMPORAL_STATISTIC)
      CASE('INSTANT VALUE')
         DV%VALUE = DV%INSTANT_VALUE
         DV%TIME_INTERVAL = 1.
      CASE('TIME AVERAGE')
         DV%VALUE = DV%VALUE + DV%INSTANT_VALUE*DT
         DV%TIME_INTERVAL = DV%TIME_INTERVAL + DT
      CASE('RUNNING AVERAGE')
         DV%VALUE = DV%AVERAGE_VALUE
         DV%TIME_INTERVAL = 1._EB
      CASE('TIME INTEGRAL')
         DV%VALUE = DV%AVERAGE_VALUE*(T-DV%STATISTICS_START)
         DV%TIME_INTERVAL = 1._EB
      CASE('MAX')
         INTERVAL_INDEX = INT((T-DV%STATISTICS_START)/(DV%STATISTICS_END-DV%STATISTICS_START)*REAL(DV%N_INTERVALS)) + 1
         INTERVAL_INDEX = MAX(1,MIN(DV%N_INTERVALS,INTERVAL_INDEX))
         DV%TIME_MAX_VALUE(INTERVAL_INDEX) = MAX(DV%INSTANT_VALUE,DV%TIME_MAX_VALUE(INTERVAL_INDEX))
         DV%TIME_INTERVAL = 1._EB
         IF (T+DT>DV%STATISTICS_END .AND. DV%TIME_PERIOD>0._EB) THEN
            CALL EXTRAPOLATE_EXTREMA
         ELSE
            DV%VALUE = DV%TIME_MAX_VALUE(INTERVAL_INDEX)
         ENDIF
      CASE('MIN')
         INTERVAL_INDEX = INT((T-DV%STATISTICS_START)/(DV%STATISTICS_END-DV%STATISTICS_START)*REAL(DV%N_INTERVALS)) + 1
         INTERVAL_INDEX = MAX(1,MIN(DV%N_INTERVALS,INTERVAL_INDEX))
         DV%TIME_MIN_VALUE(INTERVAL_INDEX) = MIN(DV%INSTANT_VALUE,DV%TIME_MIN_VALUE(INTERVAL_INDEX))
         DV%TIME_INTERVAL = 1._EB
         IF (T+DT>DV%STATISTICS_END .AND. DV%TIME_PERIOD>0._EB) THEN
            CALL EXTRAPOLATE_EXTREMA
         ELSE
            DV%VALUE = DV%TIME_MIN_VALUE(INTERVAL_INDEX)
         ENDIF
      CASE('RMS')
         WGT_UNBIASED = DT/MAX(DT,T-DV%STATISTICS_START+DT)
         DV%RMS_VALUE = (1._EB-WGT_UNBIASED)*DV%RMS_VALUE + WGT_UNBIASED*(DV%INSTANT_VALUE-DV%AVERAGE_VALUE)**2
         DV%VALUE = SQRT(DV%RMS_VALUE)
         DV%TIME_INTERVAL = 1._EB
      CASE('COV')
         WGT_UNBIASED = DT/MAX(DT,T-DV%STATISTICS_START+DT)
         DV%AVERAGE_VALUE2 = (1._EB-WGT)*DV%AVERAGE_VALUE2 + WGT*DV%VALUE_2
         DV%COV_VALUE = (1._EB-WGT_UNBIASED)*DV%COV_VALUE + &
                        WGT_UNBIASED*(DV%INSTANT_VALUE-DV%AVERAGE_VALUE)*(DV%VALUE_2-DV%AVERAGE_VALUE2)
         DV%VALUE = DV%COV_VALUE
         DV%TIME_INTERVAL = 1._EB
      CASE('CORRCOEF')
         WGT_UNBIASED = DT/MAX(DT,T-DV%STATISTICS_START+DT)
         DV%AVERAGE_VALUE2 = (1._EB-WGT)*DV%AVERAGE_VALUE2 + WGT*DV%VALUE_2
         DV%COV_VALUE  = (1._EB-WGT_UNBIASED)*DV%COV_VALUE + &
                         WGT_UNBIASED*(DV%INSTANT_VALUE-DV%AVERAGE_VALUE)*(DV%VALUE_2-DV%AVERAGE_VALUE2)
         DV%RMS_VALUE  = (1._EB-WGT_UNBIASED)*DV%RMS_VALUE + WGT_UNBIASED*(DV%INSTANT_VALUE-DV%AVERAGE_VALUE )**2
         DV%RMS_VALUE2 = (1._EB-WGT_UNBIASED)*DV%RMS_VALUE2+ WGT_UNBIASED*(DV%VALUE_2      -DV%AVERAGE_VALUE2)**2
         DV%VALUE      = DV%COV_VALUE/SQRT(DV%RMS_VALUE*DV%RMS_VALUE2)
         DV%TIME_INTERVAL = 1._EB
   END SELECT

ENDDO DEVICE_LOOP

END SUBROUTINE UPDATE_DEVICES_2


REAL(EB) RECURSIVE FUNCTION GAS_PHASE_OUTPUT(II,JJ,KK,IND,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX, &
   REAC_INDEX,MATL_INDEX,T,DT,NM) &
   RESULT(GAS_PHASE_OUTPUT_RES)

! Compute Gas Phase Output Quantities

USE MEMORY_FUNCTIONS, ONLY: REALLOCATE
USE MATH_FUNCTIONS, ONLY: INTERPOLATE1D,INTERPOLATE1D_UNIFORM,EVALUATE_RAMP,UPDATE_HISTOGRAM
USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION,FED,FIC,GET_SPECIFIC_HEAT,GET_AVERAGE_SPECIFIC_HEAT,RELATIVE_HUMIDITY, &
                              GET_CONDUCTIVITY,GET_MOLECULAR_WEIGHT,GET_MASS_FRACTION_ALL,GET_SENSIBLE_ENTHALPY, &
                              LES_FILTER_WIDTH_FUNCTION,GET_VISCOSITY,GET_POTENTIAL_TEMPERATURE,GET_SPECIFIC_GAS_CONSTANT
USE SCRC, ONLY: SCARC_ITERATIONS, SCARC_RESIDUAL, SCARC_CAPPA
USE RADCONS, ONLY: WL_LOW, WL_HIGH, RADTMP
USE RAD, ONLY: BLACKBODY_FRACTION
USE MANUFACTURED_SOLUTIONS, ONLY: UF_MMS,WF_MMS,VD2D_MMS_P_3,VD2D_MMS_H_3

REAL(EB), INTENT(IN) :: T,DT
INTEGER, INTENT(IN) :: II,JJ,KK,IND,IND2,NM,VELO_INDEX,PIPE_INDEX,PROP_INDEX,REAC_INDEX,MATL_INDEX
REAL(EB) :: FLOW,HMFAC,H_TC,TMP_TC,RE_D,NUSSELT,AREA,VEL,K_G,MU_G,DUMMY,DROPLET_COOLING,&
            Q_SUM,TMP_G,UU,VV,WW,VEL2,Y_MF_INT,PATHLENGTH,EXT_COEF,MASS_EXT_COEF,ZZ_FUEL,ZZ_OX,&
            VELSR,WATER_VOL_FRAC,RHS,DT_C,DT_E,T_RATIO,Y_E_LAG, H_G,H_G_SUM,CPBAR,CP,ZZ_GET(1:N_TRACKED_SPECIES),RCON,&
            EXPON,Y_SPECIES,MEC,Y_SPECIES2,Y_H2O,R_Y_H2O,R_DN,SGN,Y_ALL(N_SPECIES),H_S,D_Z_N(0:5000),&
            DISSIPATION_RATE,S11,S22,S33,S12,S13,S23,DUDX,DUDY,DUDZ,DVDX,DVDY,DVDZ,DWDX,DWDY,DWDZ,ONTHDIV,SS,ETA,DELTA,R_DX2,&
            UVW,UODX,VODY,WODZ,XHAT,ZHAT,BBF,RHO2,RHO_S,GAMMA_LOC,VC,TIME_RAMP_FACTOR
INTEGER :: N,I,J,K,NN,IL,III,JJJ,KKK,Y_INDEX,Z_INDEX,PART_INDEX,IP,JP,KP,FLOW_INDEX,IW,FED_ACTIVITY,&
           IP1,JP1,KP1,IM1,JM1,KM1,IIM1,JJM1,KKM1,NR,NS,RAM
CHARACTER(MESSAGE_LENGTH) :: MESSAGE
REAL(FB) :: RN
REAL(EB), PARAMETER :: EPS=1.E-10_EB
REAL :: CPUTIME

! Get species mass fraction if necessary

Y_H2O     = 0._EB
R_Y_H2O   = 0._EB
Y_SPECIES = 1._EB

IF (Z_INDEX > 0) THEN
   Y_SPECIES = ZZ(II,JJ,KK,Z_INDEX)
   RCON = SPECIES_MIXTURE(Z_INDEX)%RCON
ELSEIF (Y_INDEX > 0) THEN
   ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
   RCON = SPECIES(Y_INDEX)%RCON
   CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
ENDIF
IF (DRY .AND. H2O_INDEX > 0) THEN
   ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
   CALL GET_MASS_FRACTION(ZZ_GET,H2O_INDEX,Y_H2O)
   R_Y_H2O = SPECIES(H2O_INDEX)%RCON * Y_H2O
   IF (Y_INDEX==H2O_INDEX) Y_SPECIES=0._EB
ENDIF

! Get desired output value

IND_SELECT: SELECT CASE(IND)
   CASE DEFAULT  ! SMOKE/WATER
      GAS_PHASE_OUTPUT_RES = 0._EB
   CASE( 1)  ! DENSITY
      GAS_PHASE_OUTPUT_RES = RHO(II,JJ,KK)*Y_SPECIES
   CASE( 2)  ! F_X
      GAS_PHASE_OUTPUT_RES = FVX(II,JJ,KK)
   CASE( 3)  ! F_Y
      GAS_PHASE_OUTPUT_RES = FVY(II,JJ,KK)
   CASE( 4)  ! F_Z
      GAS_PHASE_OUTPUT_RES = FVZ(II,JJ,KK)
   CASE( 5)  ! TEMPERATURE
      GAS_PHASE_OUTPUT_RES = TMP(II,JJ,KK) - TMPM
   CASE( 6)  ! U-VELOCITY
      GAS_PHASE_OUTPUT_RES = U(II,JJ,KK)
   CASE( 7)  ! V-VELOCITY
      GAS_PHASE_OUTPUT_RES = V(II,JJ,KK)
   CASE( 8)  ! W-VELOCITY
      GAS_PHASE_OUTPUT_RES = W(II,JJ,KK)
   CASE( 9)  ! PRESSURE
      GAS_PHASE_OUTPUT_RES  = PBAR(KK,PRESSURE_ZONE(II,JJ,KK)) + RHO(II,JJ,KK)*(H(II,JJ,KK)-KRES(II,JJ,KK)) - P_0(KK)
   CASE(10)  ! VELOCITY
      SELECT CASE(ABS(VELO_INDEX))
         CASE DEFAULT
            SGN = 1._EB
         CASE(1)
            SGN = SIGN(1._EB,U(II,JJ,KK))*SIGN(1,VELO_INDEX)
         CASE(2)
            SGN = SIGN(1._EB,V(II,JJ,KK))*SIGN(1,VELO_INDEX)
         CASE(3)
            SGN = SIGN(1._EB,W(II,JJ,KK))*SIGN(1,VELO_INDEX)
      END SELECT
      GAS_PHASE_OUTPUT_RES = SGN*SQRT(2._EB*KRES(II,JJ,KK))
   CASE(11)  ! HRRPUV
      GAS_PHASE_OUTPUT_RES = Q(II,JJ,KK)*0.001_EB
   CASE(12)  ! H
      GAS_PHASE_OUTPUT_RES = H(II,JJ,KK)
   CASE(13)  ! MIXTURE FRACTION
      ! requires FUEL + AIR --> PROD (SIMPLE_CHEMISTRY, N_SIMPLE_CHEMISTRY_REACTIONS=1)
      ! f = Z_FUEL + Z_PROD/(1+S), where S is the mass stoichiometric coefficient for AIR
      GAS_PHASE_OUTPUT_RES = ZZ(II,JJ,KK,REACTION(1)%FUEL_SMIX_INDEX)+ZZ(II,JJ,KK,REACTION(1)%N_SMIX)/(1._EB+REACTION(1)%S)
   CASE(14)  ! DIVERGENCE
      GAS_PHASE_OUTPUT_RES = D(II,JJ,KK)
   CASE(15)  ! MIXING TIME
      GAS_PHASE_OUTPUT_RES = MIX_TIME(II,JJ,KK)
   CASE(16)  ! ABSORPTION COEFFICIENT
      GAS_PHASE_OUTPUT_RES = KAPPA_GAS(II,JJ,KK)
   CASE(17)  ! VISCOSITY
      GAS_PHASE_OUTPUT_RES = MU(II,JJ,KK)
   CASE(18)  ! INTEGRATED INTENSITY
      GAS_PHASE_OUTPUT_RES = UII(II,JJ,KK)*0.001_EB
   CASE(19)  ! RADIATION LOSS
      GAS_PHASE_OUTPUT_RES = QR(II,JJ,KK)*0.001_EB
   CASE(20)  ! PARTICLE RADIATION LOSS
      IF (N_LP_ARRAY_INDICES>0) THEN
         GAS_PHASE_OUTPUT_RES = QR_W(II,JJ,KK)*0.001_EB
      ELSE
         GAS_PHASE_OUTPUT_RES = 0._EB
      ENDIF
   CASE(21)  ! RELATIVE HUMIDITY
      IF (H2O_INDEX<=0) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
         CALL GET_MASS_FRACTION_ALL(ZZ_GET,Y_ALL)
         GAS_PHASE_OUTPUT_RES = RELATIVE_HUMIDITY(Y_ALL(H2O_INDEX),TMP(II,JJ,KK),PBAR(KK,PRESSURE_ZONE(II,JJ,KK)))
      ENDIF
   CASE(22)  ! HS
      GAS_PHASE_OUTPUT_RES = HS(II,JJ,KK)
   CASE(23)  ! KINETIC ENERGY (per unit mass) -- do not average because this operation is dissipative
      UU   = U(MIN(IBAR,II),JJ,KK)
      VV   = V(II,MIN(JBAR,JJ),KK)
      WW   = W(II,JJ,MIN(KBAR,KK))
      GAS_PHASE_OUTPUT_RES  = 0.5_EB*( UU**2 + VV**2 + WW**2 )

   CASE(24)  ! STRAIN RATE X
      III = MAX(1,MIN(II,IBAR))
      GAS_PHASE_OUTPUT_RES = (W(III,JJ+1,KK)-W(III,JJ,KK))*RDYN(JJ) + (V(III,JJ,KK+1)-V(III,JJ,KK))*RDZN(KK)
   CASE(25)  ! STRAIN RATE Y
      JJJ = MAX(1,MIN(JJ,JBAR))
      GAS_PHASE_OUTPUT_RES = (U(II,JJJ,KK+1)-U(II,JJJ,KK))*RDZN(KK) + (W(II+1,JJJ,KK)-W(II,JJJ,KK))*RDXN(II)
   CASE(26)  ! STRAIN RATE Z
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT_RES = (V(II+1,JJ,KKK)-V(II,JJ,KKK))*RDXN(II) + (U(II,JJ+1,KKK)-U(II,JJ,KKK))*RDYN(JJ)
   CASE(27)  ! VORTICITY X
      III = MAX(1,MIN(II,IBAR))
      GAS_PHASE_OUTPUT_RES = (W(III,JJ+1,KK)-W(III,JJ,KK))*RDYN(JJ) - (V(III,JJ,KK+1)-V(III,JJ,KK))*RDZN(KK)
   CASE(28)  ! VORTICITY Y
      JJJ = MAX(1,MIN(JJ,JBAR))
      GAS_PHASE_OUTPUT_RES = (U(II,JJJ,KK+1)-U(II,JJJ,KK))*RDZN(KK) - (W(II+1,JJJ,KK)-W(II,JJJ,KK))*RDXN(II)
   CASE(29)  ! VORTICITY Z
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT_RES = (V(II+1,JJ,KKK)-V(II,JJ,KKK))*RDXN(II) - (U(II,JJ+1,KKK)-U(II,JJ,KKK))*RDYN(JJ)

   CASE(30)  ! SMAGORINSKY COEFFICIENT
      III = MAX(1,MIN(II,IBAR))
      JJJ = MAX(1,MIN(JJ,JBAR))
      KKK = MAX(1,MIN(KK,KBAR))
      DELTA = LES_FILTER_WIDTH_FUNCTION(DX(III),DY(JJJ),DZ(KKK))
      GAS_PHASE_OUTPUT_RES = SQRT(CSD2(III,JJJ,KKK))/DELTA

   CASE(31)  ! SPECIFIC HEAT
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_SPECIFIC_HEAT(ZZ_GET,CP,TMP(II,JJ,KK))
      GAS_PHASE_OUTPUT_RES = CP*0.001_EB

   CASE(32)  ! HRRPUA
      GAS_PHASE_OUTPUT_RES = Q(II,JJ,KK)*0.001_EB*(DX(II)*DY(JJ)*DZ(KK))**ONTH

   CASE(33)  ! CONDUCTIVITY
      IF (SIM_MODE==DNS_MODE) THEN
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
         CALL GET_CONDUCTIVITY(ZZ_GET,GAS_PHASE_OUTPUT_RES,TMP(II,JJ,KK))
      ELSE
         GAS_PHASE_OUTPUT_RES = MU(II,JJ,KK)*CPOPR
      ENDIF

   CASE(34)  ! BACKGROUND PRESSURE
      GAS_PHASE_OUTPUT_RES = PBAR(KK,PRESSURE_ZONE(II,JJ,KK))

   CASE(35)  ! MOLECULAR WEIGHT
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_MOLECULAR_WEIGHT(ZZ_GET,GAS_PHASE_OUTPUT_RES)

   CASE(36)  ! POTENTIAL TEMPERATURE
      GAS_PHASE_OUTPUT_RES = GET_POTENTIAL_TEMPERATURE(TMP(II,JJ,KK),ZC(KK))

   CASE(37)  ! DIFFUSIVITY
      SELECT CASE (SIM_MODE)
         CASE DEFAULT
            GAS_PHASE_OUTPUT_RES = MU(II,JJ,KK)*RSC/RHO(II,JJ,KK)
         CASE (LES_MODE)
            GAS_PHASE_OUTPUT_RES = (MU(II,JJ,KK)-MU_DNS(II,JJ,KK)*RSC)/RHO(II,JJ,KK)
         CASE (DNS_MODE)
            D_Z_N = D_Z(:,Z_INDEX)
            CALL INTERPOLATE1D_UNIFORM(LBOUND(D_Z_N,1),D_Z_N,TMP(II,JJ,KK),GAS_PHASE_OUTPUT_RES)
      END SELECT

   CASE(38)  ! RTE SOURCE CORRECTION FACTOR
      GAS_PHASE_OUTPUT_RES = RTE_SOURCE_CORRECTION_FACTOR
   CASE(39)  ! RAM (non-standard. You must uncomment GETPID in func.f90/SYSTEM_MEM_USAGE to use this quantity.)
      CALL SYSTEM_MEM_USAGE(RAM)
      GAS_PHASE_OUTPUT_RES = REAL(RAM,EB)/1000._EB
   CASE(40)  ! TIME
      GAS_PHASE_OUTPUT_RES = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
   CASE(41)  ! TIME STEP
      GAS_PHASE_OUTPUT_RES = DT
   CASE(42)  ! WALL CLOCK TIME
      GAS_PHASE_OUTPUT_RES = CURRENT_TIME() - WALL_CLOCK_START
   CASE(43)  ! WALL CLOCK TIME ITERATIONS
      IF (INITIALIZATION_PHASE) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         GAS_PHASE_OUTPUT_RES = CURRENT_TIME() - WALL_CLOCK_START_ITERATIONS
      ENDIF
   CASE(44)  ! CPU TIME
      CALL CPU_TIME(CPUTIME)
      GAS_PHASE_OUTPUT_RES = CPUTIME - CPU_TIME_START
   CASE(45)  ! ITERATION
      GAS_PHASE_OUTPUT_RES = ICYC

   CASE(46:47)  ! SPECIFIC ENTHALPY and ENTHALPY
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_AVERAGE_SPECIFIC_HEAT(ZZ_GET,CPBAR,TMP(II,JJ,KK))
      IF (IND==46) GAS_PHASE_OUTPUT_RES = CPBAR*TMP(II,JJ,KK)*0.001_EB
      IF (IND==47) GAS_PHASE_OUTPUT_RES = RHO(II,JJ,KK)*CPBAR*TMP(II,JJ,KK)*0.001_EB

   CASE(48:49)  ! SPECIFIC SENSIBLE ENTHALPY and SENSIBLE ENTHALPY
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,TMP(II,JJ,KK))
      IF (IND==48) GAS_PHASE_OUTPUT_RES = H_S*0.001_EB
      IF (IND==49) GAS_PHASE_OUTPUT_RES = RHO(II,JJ,KK)*H_S*0.001_EB

!    CASE(50)  ! TURBULENCE RESOLUTION (measure of turbulence resolution)
!       GAS_PHASE_OUTPUT_RES = MEASURE_TURBULENCE_RESOLUTION(II,JJ,KK,NM)

!    CASE(51)  ! SCALAR RESOLUTION (measure of scalar resolution)
!       GAS_PHASE_OUTPUT_RES = MEASURE_SCALAR_RESOLUTION(II,JJ,KK,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,NM)

   CASE(52)  ! WAVELET ERROR (wavelet error measure)
      GAS_PHASE_OUTPUT_RES = WAVELET_ERROR_MEASURE(II,JJ,KK,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,DT,NM)

   CASE(53)  ! CELL U
      III = MAX(1,MIN(II,IBAR))
      GAS_PHASE_OUTPUT_RES = 0.5_EB*(U(III,JJ,KK)+U(MAX(1,III-1),JJ,KK))
   CASE(54)  ! CELL V
      JJJ = MAX(1,MIN(JJ,JBAR))
      GAS_PHASE_OUTPUT_RES = 0.5_EB*(V(II,JJJ,KK)+V(II,MAX(1,JJJ-1),KK))
   CASE(55)  ! CELL W
      KKK = MAX(1,MIN(KK,KBAR))
      GAS_PHASE_OUTPUT_RES = 0.5_EB*(W(II,JJ,KKK)+W(II,JJ,MAX(1,KKK-1)))

   CASE(56)  ! SUBGRID KINETIC ENERGY (per unit mass)
      DELTA = LES_FILTER_WIDTH_FUNCTION(DX(II),DY(JJ),DZ(KK))
      GAS_PHASE_OUTPUT_RES = SUBGRID_KINETIC_ENERGY(MU(II,JJ,KK)-MU_DNS(II,JJ,KK),RHO(II,JJ,KK),C_DEARDORFF,DELTA)

   CASE(57)  ! MAXIMUM VELOCITY ERROR
      GAS_PHASE_OUTPUT_RES = MAXVAL(VELOCITY_ERROR_MAX)

   CASE(58)  ! PRESSURE ITERATIONS
      GAS_PHASE_OUTPUT_RES = PRESSURE_ITERATIONS

   CASE(59)  ! OPEN NOZZLES
      GAS_PHASE_OUTPUT_RES = DEVC_PIPE_OPERATING(PIPE_INDEX)

   CASE(60)  ! ACTUATED SPRINKLERS
      GAS_PHASE_OUTPUT_RES = N_ACTUATED_SPRINKLERS

   CASE(61)  ! U MASK
      GAS_PHASE_OUTPUT_RES = REAL(U_MASK(II,JJ,KK),EB)
   CASE(62)  ! V MASK
      GAS_PHASE_OUTPUT_RES = REAL(V_MASK(II,JJ,KK),EB)
   CASE(63)  ! W MASK
      GAS_PHASE_OUTPUT_RES = REAL(W_MASK(II,JJ,KK),EB)
   CASE(64)  ! P MASK
      GAS_PHASE_OUTPUT_RES = REAL(P_MASK(II,JJ,KK),EB)

   CASE(65)  ! SCARC RESIDUAL
      GAS_PHASE_OUTPUT_RES = SCARC_RESIDUAL
   CASE(66)  ! SCARC ITERATIONS
      GAS_PHASE_OUTPUT_RES = SCARC_ITERATIONS
   CASE(67)  ! SCARC CONVERGENCE RATE
      GAS_PHASE_OUTPUT_RES = SCARC_CAPPA

   CASE(68:69)  ! SPECIFIC INTERNAL ENERGY and INTERNAL ENERGY (per unit volume)
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_AVERAGE_SPECIFIC_HEAT(ZZ_GET,CPBAR,TMP(II,JJ,KK))
      IF (IND==68) GAS_PHASE_OUTPUT_RES = (CPBAR*TMP(II,JJ,KK)-PBAR(KK,PRESSURE_ZONE(II,JJ,KK))/RHO(II,JJ,KK))*0.001_EB
      IF (IND==69) GAS_PHASE_OUTPUT_RES = (RHO(II,JJ,KK)*CPBAR*TMP(II,JJ,KK)-PBAR(KK,PRESSURE_ZONE(II,JJ,KK)))*0.001_EB

   CASE(70)  ! CFL
      IF (SOLID(CELL_INDEX(II,JJ,KK))) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         UODX = MAXVAL(ABS(US(II-1:II,JJ,KK)))*RDX(II)
         VODY = MAXVAL(ABS(VS(II,JJ-1:JJ,KK)))*RDY(JJ)
         WODZ = MAXVAL(ABS(WS(II,JJ,KK-1:KK)))*RDZ(KK)
         SELECT CASE (CFL_VELOCITY_NORM)
            CASE(0) ; UVW = MAX(UODX,VODY,WODZ) + ABS(DS(II,JJ,KK))
            CASE(1) ; UVW = UODX + VODY + WODZ  + ABS(DS(II,JJ,KK))
            CASE(2) ; UVW = SQRT(UODX**2+VODY**2+WODZ**2) + ABS(DS(II,JJ,KK))
            CASE(3) ; UVW = MAX(UODX,VODY,WODZ)
         END SELECT
         GAS_PHASE_OUTPUT_RES = DT*UVW
      ENDIF

   CASE(71)  ! VN
      IF (TWO_D) THEN
         R_DX2 = RDX(II)**2 + RDZ(KK)**2
      ELSE
         R_DX2 = RDX(II)**2 + RDY(JJ)**2 + RDZ(KK)**2
      ENDIF
      GAS_PHASE_OUTPUT_RES = DT*2._EB*R_DX2*MAX(D_Z_MAX(II,JJ,KK),MAX(RPR,RSC)*MU(II,JJ,KK)/RHO(II,JJ,KK))

   CASE(72)  ! CFL MAX
      GAS_PHASE_OUTPUT_RES = CFL
   CASE(73)  ! VN MAX
      GAS_PHASE_OUTPUT_RES = VN
   CASE(74)  ! POISSON ERROR
      GAS_PHASE_OUTPUT_RES = POIS_ERR
   CASE(75)  ! DIVERGENCE ERROR
      GAS_PHASE_OUTPUT_RES = RESMAX
   CASE(76)  ! RADIAL VELOCITY
      GAS_PHASE_OUTPUT_RES = ( XC(II)*0.5_EB*(U(II,JJ,KK)+U(II-1,JJ,KK)) + YC(JJ)*0.5_EB*(V(II,JJ,KK)+V(II,JJ-1,KK)) )/ &
                             SQRT(XC(II)**2+YC(JJ)**2)

   CASE(80)  ! I
      GAS_PHASE_OUTPUT_RES = REAL(II,EB)
   CASE(81)  ! J
      GAS_PHASE_OUTPUT_RES = REAL(JJ,EB)
   CASE(82)  ! K
      GAS_PHASE_OUTPUT_RES = REAL(KK,EB)

   CASE(83)  ! Q CRITERION : Q = 1/2 (tr(Dij)^2 - tr(Dij^2))
      GAS_PHASE_OUTPUT_RES = 0._EB
      III=II; JJJ=JJ; KKK=KK
      IF (II == 0   ) III = II+1
      IF (II == IBP1) III = II-1
      IF (JJ == 0   ) JJJ = JJ+1
      IF (JJ == JBP1) JJJ = JJ-1
      IF (KK == 0   ) KKK = KK+1
      IF (KK == KBP1) KKK = KK-1
      IM1 = III-1
      JM1 = JJJ-1
      KM1 = KKK-1
      IIM1 = MAX(1,III-1)
      JJM1 = MAX(1,JJJ-1)
      KKM1 = MAX(1,KKK-1)
      IP1 = III+1
      JP1 = JJJ+1
      KP1 = KKK+1
      DUDX = RDX(III)*(U(III,JJJ,KKK)-U(IM1,JJJ,KKK))
      DUDY = 0.25_EB*RDY(JJJ)*(U(III,JP1,KKK)-U(III,JJM1,KKK)+U(IM1,JP1,KKK)-U(IM1,JJM1,KKK))
      DUDZ = 0.25_EB*RDZ(KKK)*(U(III,JJJ,KP1)-U(III,JJJ,KKM1)+U(IM1,JJJ,KP1)-U(IM1,JJJ,KKM1))
      DVDX = 0.25_EB*RDX(III)*(V(IP1,JJJ,KKK)-V(IIM1,JJJ,KKK)+V(IP1,JM1,KKK)-V(IIM1,JM1,KKK))
      DVDY = RDY(JJJ)*(V(III,JJJ,KKK)-V(III,JM1,KKK))
      DVDZ = 0.25_EB*RDZ(KKK)*(V(III,JJJ,KP1)-V(III,JJJ,KKM1)+V(III,JM1,KP1)-V(III,JM1,KKM1))
      DWDX = 0.25_EB*RDX(III)*(W(IP1,JJJ,KKK)-W(IIM1,JJJ,KKK)+W(IP1,JJJ,KM1)-W(IIM1,JJJ,KM1))
      DWDY = 0.25_EB*RDY(JJJ)*(W(III,JP1,KKK)-W(III,JJM1,KKK)+W(III,JP1,KM1)-W(III,JJM1,KM1))
      DWDZ = RDZ(KKK)*(W(III,JJJ,KKK)-W(III,JJJ,KM1))

      ! Q = 1/2 (tr(Dij)^2 - tr(Dij^2))
      GAS_PHASE_OUTPUT_RES = 0.5_EB*( (DUDX+DVDY+DWDZ)**2._EB            - &  ! tr(Dij)^2
                                      (DUDX*DUDX + DUDY*DVDX + DUDZ*DWDX + &  ! tr(Dij^2) = Dik*Dki
                                       DVDX*DUDY + DVDY*DVDY + DVDZ*DWDY + &
                                       DWDX*DUDZ + DWDY*DVDZ + DWDZ*DWDZ))
   CASE(84)  ! STRAIN RATE
      IM1 = MAX(0,II-1)
      JM1 = MAX(0,JJ-1)
      KM1 = MAX(0,KK-1)
      IIM1 = MAX(1,II-1)
      JJM1 = MAX(1,JJ-1)
      KKM1 = MAX(1,KK-1)
      IP1 = MIN(IBAR,II+1)
      JP1 = MIN(JBAR,JJ+1)
      KP1 = MIN(KBAR,KK+1)
      DUDX = RDX(II)*(U(II,JJ,KK)-U(IM1,JJ,KK))
      DVDY = RDY(JJ)*(V(II,JJ,KK)-V(II,JM1,KK))
      DWDZ = RDZ(KK)*(W(II,JJ,KK)-W(II,JJ,KM1))
      ONTHDIV = ONTH*(DUDX+DVDY+DWDZ)
      S11 = DUDX - ONTHDIV
      S22 = DVDY - ONTHDIV
      S33 = DWDZ - ONTHDIV
      DUDY = 0.25_EB*RDY(JJ)*(U(II,JP1,KK)-U(II,JJM1,KK)+U(IM1,JP1,KK)-U(IM1,JJM1,KK))
      DUDZ = 0.25_EB*RDZ(KK)*(U(II,JJ,KP1)-U(II,JJ,KKM1)+U(IM1,JJ,KP1)-U(IM1,JJ,KKM1))
      DVDX = 0.25_EB*RDX(II)*(V(IP1,JJ,KK)-V(IIM1,JJ,KK)+V(IP1,JM1,KK)-V(IIM1,JM1,KK))
      DVDZ = 0.25_EB*RDZ(KK)*(V(II,JJ,KP1)-V(II,JJ,KKM1)+V(II,JM1,KP1)-V(II,JM1,KKM1))
      DWDX = 0.25_EB*RDX(II)*(W(IP1,JJ,KK)-W(IIM1,JJ,KK)+W(IP1,JJ,KM1)-W(IIM1,JJ,KM1))
      DWDY = 0.25_EB*RDY(JJ)*(W(II,JP1,KK)-W(II,JJM1,KK)+W(II,JP1,KM1)-W(II,JJM1,KM1))
      S12 = 0.5_EB*(DUDY+DVDX)
      S13 = 0.5_EB*(DUDZ+DWDX)
      S23 = 0.5_EB*(DVDZ+DWDY)
      GAS_PHASE_OUTPUT_RES = SQRT(2._EB*(S11**2 + S22**2 + S33**2 + 2._EB*(S12**2 + S13**2 + S23**2)))
   CASE(85)  ! KOLMOGOROV LENGTH SCALE
      SS = GAS_PHASE_OUTPUT(II,JJ,KK,84,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,&
                            REAC_INDEX,MATL_INDEX,T,DT,NM)
      DISSIPATION_RATE = MU(II,JJ,KK)/RHO(II,JJ,KK)*SS**2
      GAS_PHASE_OUTPUT_RES = ((MU_DNS(II,JJ,KK)/RHO(II,JJ,KK))**3/(DISSIPATION_RATE+EPS))**0.25_EB
   CASE(86)  ! CELL REYNOLDS NUMBER
      III = MAX(1,MIN(II,IBAR))
      JJJ = MAX(1,MIN(JJ,JBAR))
      KKK = MAX(1,MIN(KK,KBAR))
      DELTA = LES_FILTER_WIDTH_FUNCTION(DX(III),DY(JJJ),DZ(KKK))
      ETA = GAS_PHASE_OUTPUT(II,JJ,KK,85,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,&
                             REAC_INDEX,MATL_INDEX,T,DT,NM)
      GAS_PHASE_OUTPUT_RES = DELTA/(ETA+EPS)
   CASE(87)  ! MOLECULAR VISCOSITY
      GAS_PHASE_OUTPUT_RES = MU_DNS(II,JJ,KK)
   CASE(88)  ! DISSIPATION RATE
      SS = GAS_PHASE_OUTPUT(II,JJ,KK,84,IND2,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,PIPE_INDEX,PROP_INDEX,&
                            REAC_INDEX,MATL_INDEX,T,DT,NM)
      GAS_PHASE_OUTPUT_RES = MU(II,JJ,KK)/RHO(II,JJ,KK)*SS**2
   CASE(90)  ! MASS FRACTION
      GAS_PHASE_OUTPUT_RES = Y_SPECIES/(1._EB-Y_H2O)
   CASE(91:93) ! MASS FLUX
      SELECT CASE(IND)
         CASE(91) ! MASS FLUX X
            ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II+1,JJ,KK,1:N_TRACKED_SPECIES)
            RHO2      = RHO(II+1,JJ,KK)
            VEL       = U(II,JJ,KK)
            IW        = MAX(WALL_INDEX(CELL_INDEX(II,JJ,KK),1),WALL_INDEX(CELL_INDEX(II+1,JJ,KK),-1))
         CASE(92) ! MASS FLUX Y
            ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ+1,KK,1:N_TRACKED_SPECIES)
            RHO2      = RHO(II,JJ+1,KK)
            VEL       = V(II,JJ,KK)
            IW        = MAX(WALL_INDEX(CELL_INDEX(II,JJ,KK),2),WALL_INDEX(CELL_INDEX(II,JJ+1,KK),-2))
         CASE(93) ! MASS FLUX Z
            ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK+1,1:N_TRACKED_SPECIES)
            RHO2      = RHO(II,JJ,KK+1)
            VEL       = W(II,JJ,KK)
            IW        = MAX(WALL_INDEX(CELL_INDEX(II,JJ,KK),3),WALL_INDEX(CELL_INDEX(II,JJ,KK+1),-3))
      END SELECT

      IF (IW>0) THEN
         IF (WALL(IW)%BOUNDARY_TYPE==SOLID_BOUNDARY) THEN
            WRITE(MESSAGE,'(A)') "ERROR: Output QUANTITY 'MASS FLUX' not appropriate at solid boundary"
            CALL SHUTDOWN(MESSAGE,PROCESS_0_ONLY=.FALSE.)
          ENDIF
      ENDIF

      Y_SPECIES2=1.0_EB
      IF (Z_INDEX > 0) THEN
         Y_SPECIES2 = ZZ_GET(Z_INDEX)
      ELSEIF (Y_INDEX > 0) THEN
         CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES2)
      ENDIF
      GAS_PHASE_OUTPUT_RES = 0.5_EB*(RHO(II,JJ,KK)*Y_SPECIES+RHO2*Y_SPECIES2)*VEL
   CASE(94)  ! VOLUME FRACTION
      GAS_PHASE_OUTPUT_RES =  RCON*Y_SPECIES/RSUM(II,JJ,KK)/(1._EB-R_Y_H2O/RSUM(II,JJ,KK))
   CASE(95)  ! VISIBILITY
      IF (Z_INDEX>0) THEN
         MEC = SPECIES_MIXTURE(Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (Y_INDEX>0) THEN
         MEC = SPECIES(Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ENDIF
      EXT_COEF = Y_SPECIES*RHO(II,JJ,KK)*MEC
      GAS_PHASE_OUTPUT_RES = VISIBILITY_FACTOR/MAX(EC_LL,EXT_COEF)
   CASE(96)  ! AEROSOL VOLUME FRACTION
      IF (Z_INDEX >0) THEN
         GAS_PHASE_OUTPUT_RES = Y_SPECIES*RHO(II,JJ,KK)/SPECIES(SPECIES_MIXTURE(Z_INDEX)%SINGLE_SPEC_INDEX)%DENSITY_SOLID
      ELSEIF (Y_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = Y_SPECIES*RHO(II,JJ,KK)/SPECIES(Y_INDEX)%DENSITY_SOLID
      ENDIF
   CASE(97)  ! EXTINCTION COEFFICIENT
      IF (Z_INDEX>0) THEN
         MEC = SPECIES_MIXTURE(Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (Y_INDEX>0) THEN
         MEC = SPECIES(Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ENDIF
      EXT_COEF = Y_SPECIES*RHO(II,JJ,KK)*MEC
      GAS_PHASE_OUTPUT_RES = Y_SPECIES*RHO(II,JJ,KK)*MEC
   CASE(98)  ! OPTICAL DENSITY
      IF (Z_INDEX>0) THEN
         MEC = SPECIES_MIXTURE(Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (Y_INDEX>0) THEN
         MEC = SPECIES(Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ENDIF
      GAS_PHASE_OUTPUT_RES = Y_SPECIES*RHO(II,JJ,KK)*MEC/2.3_EB

   CASE(100) ! PRESSURE ZONE
      GAS_PHASE_OUTPUT_RES = PRESSURE_ZONE(II,JJ,KK)

   CASE(101)  ! FIC
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      GAS_PHASE_OUTPUT_RES = FIC(ZZ_GET,RSUM(II,JJ,KK))

   CASE(102)  ! INCAPACITATION TIME, minutes
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      IF (PROP_INDEX>0) THEN
         FED_ACTIVITY = PROPERTY(PROP_INDEX)%FED_ACTIVITY
      ELSE
         FED_ACTIVITY = 2
      ENDIF
      GAS_PHASE_OUTPUT_RES = 60.0_EB*FED(ZZ_GET,RSUM(II,JJ,KK),FED_ACTIVITY) ! [1/s] => [1/min]
      GAS_PHASE_OUTPUT_RES = 1.0_EB/MAX(.00069444444444_EB,GAS_PHASE_OUTPUT_RES) ! max is 24 h

   CASE(104) ! HRR
      Q_SUM = 0._EB
      DO K=SDV%K1,SDV%K2
         DO J=SDV%J1,SDV%J2
            DO I=SDV%I1,SDV%I2
               Q_SUM = Q_SUM + Q(I,J,K)*DX(I)*RC(I)*DY(J)*DZ(K)
            ENDDO
         ENDDO
      ENDDO
      GAS_PHASE_OUTPUT_RES = Q_SUM*0.001_EB

   CASE(105:107) ! Hot Gas Layer Reduction
      CALL GET_LAYER_HEIGHT_INTEGRALS(SDV%I1,SDV%J1,SDV%K1,SDV%K2,DV%Z_INT,DV%Z1,SDV%VALUE_1,SDV%VALUE_2,SDV%VALUE_3,DV%TMP_LOW)
      GAS_PHASE_OUTPUT_RES = SDV%VALUE_1

   CASE(109)  ! FED
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      IF (PROP_INDEX>0) THEN
         FED_ACTIVITY = PROPERTY(PROP_INDEX)%FED_ACTIVITY
      ELSE
         FED_ACTIVITY = 2
      ENDIF
      GAS_PHASE_OUTPUT_RES = FED(ZZ_GET,RSUM(II,JJ,KK),FED_ACTIVITY)

   CASE(110)  ! THERMOCOUPLE
      IF (ASSUMED_GAS_TEMPERATURE>0._EB) THEN
         TMP_G = ASSUMED_GAS_TEMPERATURE
      ELSE
         TMP_G = TMP(II,JJ,KK)
      ENDIF
      IF (PY%HEAT_TRANSFER_COEFFICIENT<0._EB) THEN
         UU      = U(II,JJ,KK)
         VV      = V(II,JJ,KK)
         WW      = W(II,JJ,KK)
         VEL2    = UU**2+VV**2+WW**2
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
         CALL GET_VISCOSITY(ZZ_GET,MU_G,TMP(II,JJ,KK))
         CALL GET_CONDUCTIVITY(ZZ_GET,K_G,TMP(II,JJ,KK))
         RE_D    = RHO(II,JJ,KK)*SQRT(VEL2)*PY%DIAMETER/MU_G
         NUSSELT = 2._EB + 0.6_EB*SQRT(RE_D)*PR_ONTH ! Incropera and DeWitt
         H_TC    = NUSSELT*K_G/PY%DIAMETER
      ELSE
         H_TC    = PY%HEAT_TRANSFER_COEFFICIENT
      ENDIF
      RHS      = (6._EB/(PY%DENSITY*PY%SPECIFIC_HEAT*PY%DIAMETER))* &
                 ( H_TC*(TMP_G-DV%TMP_L) + PY%EMISSIVITY*(0.25_EB*UII(II,JJ,KK)-SIGMA*DV%TMP_L**4) )
      DV%TMP_L = DV%TMP_L + DT*RHS
      GAS_PHASE_OUTPUT_RES = DV%TMP_L - TMPM

   CASE(111:119)  ! FLOWs
      IF (IND==111 .OR. IND==114 .OR. IND==117) FLOW_INDEX = 1  ! VOLUME FLOW
      IF (IND==112 .OR. IND==115 .OR. IND==118) FLOW_INDEX = 2  ! MASS FLOW
      IF (IND==113 .OR. IND==116 .OR. IND==119) FLOW_INDEX = 3  ! HEAT FLOW
      FLOW = 0._EB
      DO K=SDV%K1,SDV%K2
         DO J=SDV%J1,SDV%J2
            DO I=SDV%I1,SDV%I2
               IP = I
               JP = J
               KP = K
               SELECT CASE(ABS(DV%IOR_ASSUMED))
                  CASE(1)
                     IP   = I+1
                     VEL  = U(I,J,K)
                     AREA = DY(J)*DZ(K)*RC(I)
                     R_DN  = RDXN(I)
                  CASE(2)
                     JP   = J+1
                     VEL  = V(I,J,K)
                     AREA = DX(I)*DZ(K)
                     R_DN  = RDYN(J)
                  CASE(3)
                     KP   = K+1
                     VEL  = W(I,J,K)
                     AREA = DX(I)*DY(J)*RC(I)
                     R_DN  = RDZN(K)
               END SELECT
               IF ((SOLID(CELL_INDEX(I,J,K)) .OR. SOLID(CELL_INDEX(IP,JP,KP))) .AND. FLOW_INDEX/=1) THEN
                  HMFAC = 0._EB
               ELSE
                  SELECT CASE(FLOW_INDEX)
                     CASE(1)
                        HMFAC = 1._EB
                     CASE(2)
                        Y_SPECIES2=1._EB
                        ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(IP,JP,KP,1:N_TRACKED_SPECIES)
                        IF (Z_INDEX > 0) THEN
                           Y_SPECIES2 = ZZ_GET(Z_INDEX)
                        ELSEIF (Y_INDEX > 0) THEN
                           CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES2)
                        ENDIF
                        HMFAC = 0.5_EB*(Y_SPECIES*RHO(I,J,K)+Y_SPECIES2*RHO(IP,JP,KP))
                     CASE(3)
                        TMP_TC = 0.5_EB*(TMP(I,J,K)+TMP(IP,JP,KP))
                        ZZ_GET(1:N_TRACKED_SPECIES) = 0.5_EB*(ZZ(I,J,K,1:N_TRACKED_SPECIES)+ZZ(IP,JP,KP,1:N_TRACKED_SPECIES))
                        CALL GET_AVERAGE_SPECIFIC_HEAT(ZZ_GET,CPBAR,TMP_TC)
                        H_G_SUM = CPBAR*TMP_TC
                        CALL GET_AVERAGE_SPECIFIC_HEAT(ZZ_GET,CPBAR,TMPA)
                        H_G = CPBAR*TMPA
                        HMFAC = 0.5_EB*(RHO(I,J,K)+RHO(IP,JP,KP))*(H_G_SUM-H_G)*0.001_EB
                  END SELECT
               ENDIF

               SELECT CASE(IND)
                  CASE(111:113)
                     FLOW = FLOW + VEL*HMFAC*AREA
                  CASE(114:116)
                     FLOW = FLOW + MAX(0._EB,VEL)*HMFAC*AREA
                  CASE(117:119)
                     FLOW = FLOW - MIN(0._EB,VEL)*HMFAC*AREA
               END SELECT
               IF (FLOW_INDEX==3) THEN
                  IF (SIM_MODE==DNS_MODE) THEN
                     CALL GET_CONDUCTIVITY(ZZ_GET,K_G,TMP(II,JJ,KK))
                  ELSE
                     K_G = MU(I,J,K)*CPOPR
                  ENDIF
                  FLOW = FLOW - AREA*K_G*(TMP(IP,JP,KP)-TMP(I,J,K))*R_DN*0.001
               ENDIF
            ENDDO
         ENDDO
      ENDDO
      GAS_PHASE_OUTPUT_RES = FLOW

   CASE(120) ! HRRPUL
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO J=1,JBAR
         DO I=1,IBAR
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + Q(I,J,KK)*DX(I)*RC(I)*DY(J)*0.001
         ENDDO
      ENDDO

   CASE(130) ! EXTINCTION
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      ZZ_FUEL = 0._EB
      ZZ_OX = 0._EB
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NR=1,N_REACTIONS
         DO NS=1,N_TRACKED_SPECIES
            IF (REACTION(NR)%NU(NS) < 0._EB) THEN
               IF (NS == REACTION(NR)%FUEL_SMIX_INDEX) ZZ_FUEL = ZZ_FUEL + ZZ_GET(NS)
               IF (NS /= REACTION(NR)%FUEL_SMIX_INDEX .AND. NR == 1) ZZ_OX = ZZ_GET(NS)
            ENDIF
          ENDDO
       ENDDO
       IF (ZZ_FUEL < TWO_EPSILON_EB .OR. ZZ_OX < TWO_EPSILON_EB .OR. Q(II,JJ,KK) < TWO_EPSILON_EB) GAS_PHASE_OUTPUT_RES = -1._EB
       IF (ZZ_FUEL > ZZ_MIN_GLOBAL .AND. ZZ_OX > ZZ_MIN_GLOBAL .AND. Q(II,JJ,KK) < TWO_EPSILON_EB) GAS_PHASE_OUTPUT_RES = 1._EB

   CASE(131) ! CHEMISTRY SUBITERATIONS
      GAS_PHASE_OUTPUT_RES = CHEM_SUBIT(II,JJ,KK)

   CASE(132) ! REAC SOURCE TERM
      GAS_PHASE_OUTPUT_RES = REAC_SOURCE_TERM(II,JJ,KK,Z_INDEX)

   CASE(133) ! SUM LUMPED MASS FRACTIONS
      GAS_PHASE_OUTPUT_RES = SUM(ZZ(II,JJ,KK,1:N_TRACKED_SPECIES))

   CASE(134) ! SUM PRIMITIVE MASS FRACTIONS
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_MASS_FRACTION_ALL(ZZ_GET,Y_ALL)
      GAS_PHASE_OUTPUT_RES = SUM(Y_ALL)

   CASE(135) ! MACH NUMBER
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_SPECIFIC_HEAT(ZZ_GET,CP,TMP(II,JJ,KK))
      CALL GET_SPECIFIC_GAS_CONSTANT(ZZ_GET,RCON)
      GAMMA_LOC = CP/(CP-RCON)
      GAS_PHASE_OUTPUT_RES = SQRT(2._EB*KRES(II,JJ,KK))/SQRT(RCON*TMP(II,JJ,KK)*GAMMA_LOC)

   CASE(136) ! UNMIXED FRACTION
      GAS_PHASE_OUTPUT_RES = INITIAL_UNMIXED_FRACTION*EXP(-DT/MIX_TIME(II,JJ,KK))

   CASE(138) ! HRRPUV REAC
      GAS_PHASE_OUTPUT_RES = Q_REAC(II,JJ,KK,REAC_INDEX)*0.001_EB

   CASE(139) ! H PRIME
      GAS_PHASE_OUTPUT_RES = H_PRIME(II,JJ,KK)

   CASE(140) ! FVX_B
      GAS_PHASE_OUTPUT_RES = FVX_B(II,JJ,KK)
   CASE(141) ! FVY_B
      GAS_PHASE_OUTPUT_RES = FVY_B(II,JJ,KK)
   CASE(142) ! FVZ_B
      GAS_PHASE_OUTPUT_RES = FVZ_B(II,JJ,KK)

   CASE(143) ! COMBUSTION EFFICIENCY
      IF (Q(II,JJ,KK)>TWO_EPSILON_EB) THEN
         GAS_PHASE_OUTPUT_RES = MIN(DT/MIX_TIME(II,JJ,KK),1._EB)
      ELSE
         GAS_PHASE_OUTPUT_RES = 0._EB
      ENDIF

   CASE(153) ! NOZZLE FLOW RATE
      GAS_PHASE_OUTPUT_RES = PY%FLOW_RATE

   CASE(154:155) ! TRANSMISSION, PATH OBSCURATION
      EXT_COEF   = 0._EB
      IF (PY%Y_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES(PY%Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (PY%Z_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES_MIXTURE(PY%Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (SOOT_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES(SOOT_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSE
         MASS_EXT_COEF = 0._EB
      ENDIF
      DO NN=1,SDV%N_PATH
         I = SDV%I_PATH(NN)
         J = SDV%J_PATH(NN)
         K = SDV%K_PATH(NN)
         IF (PY%Y_INDEX>0) THEN
            ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(I,J,K,1:N_TRACKED_SPECIES)
            CALL GET_MASS_FRACTION(ZZ_GET,PY%Y_INDEX,Y_MF_INT)
         ELSEIF (PY%Z_INDEX>0) THEN
            Y_MF_INT = ZZ(I,J,K,PY%Z_INDEX)
         ELSE
            ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(I,J,K,1:N_TRACKED_SPECIES)
            CALL GET_MASS_FRACTION(ZZ_GET,SOOT_INDEX,Y_MF_INT)
         ENDIF
         EXT_COEF = EXT_COEF + Y_MF_INT*RHO(I,J,K)*SDV%D_PATH(NN)
      ENDDO
      GAS_PHASE_OUTPUT_RES = MASS_EXT_COEF*EXT_COEF  ! This output is only a component of the actual output QUANTITY

   CASE(156) ! SPRINKLER LINK TEMPERATURE
      I = DV%I
      J = DV%J
      K = DV%K
      TMP_G = TMP(I,J,K)
      VEL2  = 0.25_EB*( (U(I,J,K)+U(I-1,J,K))**2 +(V(I,J,K)+V(I,J-1,K))**2 + (W(I,J,K)+W(I,J,K-1))**2 )
      VEL   = SQRT(VEL2)
      VELSR = SQRT(VEL)
      WATER_VOL_FRAC = 0._EB
      IF (H2O_INDEX > 0) THEN
         DO NN = 1,N_LAGRANGIAN_CLASSES
            IF (LAGRANGIAN_PARTICLE_CLASS(NN)%Y_INDEX==H2O_INDEX) WATER_VOL_FRAC = WATER_VOL_FRAC + &
               AVG_DROP_DEN(I,J,K,LAGRANGIAN_PARTICLE_CLASS(NN)%ARRAY_INDEX)/LAGRANGIAN_PARTICLE_CLASS(NN)%DENSITY
         ENDDO
      ENDIF
      IF (DV%TMP_L>PY%INITIAL_TEMPERATURE) THEN
         DROPLET_COOLING = C_DIMARZO*VEL*WATER_VOL_FRAC
      ELSE
         DROPLET_COOLING = 0._EB
      ENDIF
      RHS      = ( VELSR*(TMP_G-DV%TMP_L) - PY%C_FACTOR*(DV%TMP_L-PY%INITIAL_TEMPERATURE) - DROPLET_COOLING )/PY%RTI
      DV%TMP_L = DV%TMP_L + DT*RHS
      GAS_PHASE_OUTPUT_RES = DV%TMP_L - TMPM

   CASE(157) ! LINK TEMPERATURE
      I = DV%I
      J = DV%J
      K = DV%K
      TMP_G = TMP(I,J,K)
      VEL2  = 0.25_EB*( (U(I,J,K)+U(I-1,J,K))**2 + (V(I,J,K)+V(I,J-1,K))**2 + (W(I,J,K)+W(I,J,K-1))**2 )
      VEL   = SQRT(VEL2)
      VELSR = SQRT(VEL)
      DV%TMP_L  = DV%TMP_L + DT*VELSR*(TMP_G-DV%TMP_L)/PY%RTI
      GAS_PHASE_OUTPUT_RES       = DV%TMP_L - TMPM

   CASE(158) ! CHAMBER OBSCURATION
      IF (Y_INDEX > 0) THEN
         MASS_EXT_COEF = SPECIES(Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (Z_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES_MIXTURE(Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (SOOT_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES(SOOT_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSE
         MASS_EXT_COEF = 0._EB
      ENDIF
      I = DV%I
      J = DV%J
      K = DV%K
      VEL2 = 0.25_EB*( (U(I,J,K)+U(I-1,J,K))**2 + (V(I,J,K)+V(I,J-1,K))**2 + (W(I,J,K)+W(I,J,K-1))**2 )
      VEL  = MAX(SQRT(VEL2),1.0E-10_EB)
      IF (DV%N_T_E>=UBOUND(DV%T_E,1)) THEN
         DV%T_E => REALLOCATE(DV%T_E,-1,DV%N_T_E+1000)
         DV%Y_E => REALLOCATE(DV%Y_E,-1,DV%N_T_E+1000)
      ENDIF
      DV%N_T_E = DV%N_T_E + 1
      DV%Y_E(DV%N_T_E) = Y_SPECIES
      DV%T_E(DV%N_T_E) = T
      DT_C = PY%ALPHA_C*VEL**PY%BETA_C
      DT_E = PY%ALPHA_E*VEL**PY%BETA_E
      Y_E_LAG = 0._EB
      LAG_LOOP: DO IL=DV%N_T_E-1,0,-1
         IF (DV%T_E(IL) > T-DT_E) CYCLE LAG_LOOP
         T_RATIO = (T-DT_E-DV%T_E(IL))/(DV%T_E(IL+1)-DV%T_E(IL))
         Y_E_LAG = DV%Y_E(IL) + T_RATIO*(DV%Y_E(IL+1)-DV%Y_E(IL))
         EXIT LAG_LOOP
      ENDDO LAG_LOOP
      DV%Y_C = DV%Y_C + DT*(Y_E_LAG - DV%Y_C)/DT_C
      GAS_PHASE_OUTPUT_RES = (1._EB-EXP(-MASS_EXT_COEF*RHO(I,J,K)*DV%Y_C))*100._EB  ! Obscuration

   CASE(159) ! CONTROL VALUE
      GAS_PHASE_OUTPUT_RES = CONTROL(DV%CTRL_INDEX)%INSTANT_VALUE

   CASE(160) ! CONTROL
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (CONTROL(DV%CTRL_INDEX)%CURRENT_STATE) GAS_PHASE_OUTPUT_RES = 1._EB

   CASE(161) ! ASPIRATION
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF (T >= DV%T) THEN
         ! If enough time has passed shift soot density array
         DV%T = T + DV%DT
         DV%TIME_ARRAY(0:99) = DV%TIME_ARRAY(1:100)
         DV%YY_SOOT(:,0:99) = DV%YY_SOOT(:,1:100)
         DV%YY_SOOT(:,100) = 0._EB
      ENDIF
      DV%TIME_ARRAY(100) = T
      DO N = 1, DV%N_INPUTS
         ! Update soot density array
         DV2 => DEVICE(DV%DEVC_INDEX(N))
         IF (ABS(DV%T - T - DV%DT)<=SPACING(DV%T)) THEN
            DV%YY_SOOT(N,100) = DV2%INSTANT_VALUE
         ELSE
            DV%YY_SOOT(N,100) = (DV%YY_SOOT(N,100) * (T - DV%TIME_ARRAY(99) - DT) +  DT * DV2%INSTANT_VALUE) / &
                                (T - DV%TIME_ARRAY(99))
         END IF
         ! Sum soot densities weighted by flow rate
         CALL INTERPOLATE1D(DV%TIME_ARRAY,DV%YY_SOOT(N,:),T-DV2%DELAY,Y_SPECIES)
         GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + DV2%FLOWRATE * Y_SPECIES
      END DO
      ! Complete weighting and compute % obs
      GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES / DV%TOTAL_FLOWRATE
      IF (DV2%Y_INDEX > 0) THEN
         MASS_EXT_COEF = SPECIES(DV2%Y_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (DV2%Z_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES_MIXTURE(DV2%Z_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSEIF (SOOT_INDEX>0) THEN
         MASS_EXT_COEF = SPECIES(SOOT_INDEX)%MASS_EXTINCTION_COEFFICIENT
      ELSE
         MASS_EXT_COEF = 0._EB
      ENDIF
      GAS_PHASE_OUTPUT_RES = (1._EB-EXP(-MASS_EXT_COEF*GAS_PHASE_OUTPUT_RES))*100._EB  ! Obscuration

   CASE(162) ! ASSUMED GAS TEMPERATURE
      GAS_PHASE_OUTPUT_RES = TMPA + EVALUATE_RAMP(T-T_BEGIN,DUMMY,I_RAMP_AGT)*(ASSUMED_GAS_TEMPERATURE-TMPA) - TMPM

   CASE(163) ! PATHLENGTH
      PATHLENGTH = 0._EB
      DO NN=1,SDV%N_PATH
         PATHLENGTH = PATHLENGTH + SDV%D_PATH(NN)
      ENDDO
      GAS_PHASE_OUTPUT_RES = PATHLENGTH

   CASE(170) ! MPUV
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT_RES = AVG_DROP_DEN(II,JJ,KK,LPC%ARRAY_INDEX)

   CASE(171) ! ADD
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT_RES = AVG_DROP_RAD(II,JJ,KK,LPC%ARRAY_INDEX)*2.E6_EB

   CASE(172) ! ADT
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT_RES = AVG_DROP_TMP(II,JJ,KK,LPC%ARRAY_INDEX) - TMPM

   CASE(173) ! ADA
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      GAS_PHASE_OUTPUT_RES = AVG_DROP_AREA(II,JJ,KK,LPC%ARRAY_INDEX)

   CASE(174) ! QABS
      GAS_PHASE_OUTPUT_RES = 0._EB
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      IF (ABS(AVG_DROP_AREA(II,JJ,KK,LPC%ARRAY_INDEX))>TWO_EPSILON_EB) THEN
         DO N = 1,NUMBER_SPECTRAL_BANDS
            IF (NUMBER_SPECTRAL_BANDS==1) THEN
               BBF = 1._EB
            ELSE
               BBF = BLACKBODY_FRACTION(WL_LOW(N),WL_HIGH(N),RADTMP)
            ENDIF
            CALL INTERPOLATE1D(LPC%R50,LPC%WQABS(:,N),AVG_DROP_RAD(II,JJ,KK,LPC%ARRAY_INDEX),Q_SUM)
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + BBF*Q_SUM
         ENDDO
         GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES/REAL(NUMBER_SPECTRAL_BANDS,EB)
      ENDIF

   CASE(175) ! QSCA
      GAS_PHASE_OUTPUT_RES = 0._EB
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      IF (ABS(AVG_DROP_AREA(II,JJ,KK,LPC%ARRAY_INDEX))>TWO_EPSILON_EB) THEN
         DO N = 1,NUMBER_SPECTRAL_BANDS
            IF (NUMBER_SPECTRAL_BANDS==1) THEN
               BBF = 1._EB
            ELSE
               BBF = BLACKBODY_FRACTION(WL_LOW(N),WL_HIGH(N),RADTMP)
            ENDIF
            CALL INTERPOLATE1D(LPC%R50,LPC%WQSCA(:,N),AVG_DROP_RAD(II,JJ,KK,LPC%ARRAY_INDEX),Q_SUM)
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + BBF*Q_SUM
         ENDDO
         GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES/REAL(NUMBER_SPECTRAL_BANDS,EB)
      ENDIF

   CASE(176) ! PARTICLE FLUX X
      GAS_PHASE_OUTPUT_RES = WFX(II,JJ,KK)

   CASE(177) ! PARTICLE FLUX Y
      GAS_PHASE_OUTPUT_RES = WFY(II,JJ,KK)

   CASE(178) ! PARTICLE FLUX Z
      GAS_PHASE_OUTPUT_RES = WFZ(II,JJ,KK)

   CASE(179) ! MPUV_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) &
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + AVG_DROP_DEN(II,JJ,KK,LAGRANGIAN_PARTICLE_CLASS(NN)%ARRAY_INDEX)
      ENDDO

   CASE(180) ! ADD_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) &
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + AVG_DROP_RAD(II,JJ,KK,LAGRANGIAN_PARTICLE_CLASS(NN)%ARRAY_INDEX)
      ENDDO

   CASE(181) ! ADT_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) &
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES +  AVG_DROP_TMP(II,JJ,KK,LAGRANGIAN_PARTICLE_CLASS(NN)%ARRAY_INDEX)-TMPM
      ENDDO

   CASE(182) ! ADA_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) &
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + AVG_DROP_AREA(II,JJ,KK,LAGRANGIAN_PARTICLE_CLASS(NN)%ARRAY_INDEX)
      ENDDO

   CASE(183) ! QABS_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) THEN
            IF (ABS(AVG_DROP_AREA(II,JJ,KK,LPC%ARRAY_INDEX))>TWO_EPSILON_EB) THEN
               DO N = 1,NUMBER_SPECTRAL_BANDS
                  IF (NUMBER_SPECTRAL_BANDS==1) THEN
                     BBF = 1._EB
                  ELSE
                     BBF = BLACKBODY_FRACTION(WL_LOW(N),WL_HIGH(N),RADTMP)
                  ENDIF
                  CALL INTERPOLATE1D(LPC%R50,LPC%WQABS(:,N),AVG_DROP_RAD(II,JJ,KK,LPC%ARRAY_INDEX),Q_SUM)
                  GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + BBF*Q_SUM
               ENDDO
            ENDIF
         ENDIF
      ENDDO
      GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES/REAL(NUMBER_SPECTRAL_BANDS,EB)

   CASE(184) ! QSCA_Z
      GAS_PHASE_OUTPUT_RES = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) THEN
            IF (ABS(AVG_DROP_AREA(II,JJ,KK,LPC%ARRAY_INDEX))>TWO_EPSILON_EB) THEN
               DO N = 1,NUMBER_SPECTRAL_BANDS
                  IF (NUMBER_SPECTRAL_BANDS==1) THEN
                     BBF = 1._EB
                  ELSE
                     BBF = BLACKBODY_FRACTION(WL_LOW(N),WL_HIGH(N),RADTMP)
                  ENDIF
                  CALL INTERPOLATE1D(LPC%R50,LPC%WQSCA(:,N),AVG_DROP_RAD(II,JJ,KK,LPC%ARRAY_INDEX),Q_SUM)
                  GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + BBF*Q_SUM
               ENDDO
            ENDIF
         ENDIF
      ENDDO
      GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES/REAL(NUMBER_SPECTRAL_BANDS,EB)

   CASE(185) ! NUMBER OF PARTICLES
      GAS_PHASE_OUTPUT_RES = NLP

   CASE(230) ! RANDOM NUMBER
      CALL RANDOM_NUMBER(RN)
      GAS_PHASE_OUTPUT_RES = REAL(RN,EB)

   CASE(231) ! PDPA
      GAS_PHASE_OUTPUT_RES = 0._EB
      IF ( ((PY%PDPA_START<=T) .AND. (PY%PDPA_END>=T)) .OR. .NOT.PY%PDPA_INTEGRATE ) THEN
         IF ((PY%PDPA_M-PY%PDPA_N) == 0) THEN
            EXPON = 1._EB
         ELSEIF ((PY%QUANTITY=='MASS CONCENTRATION') .OR. &
                 (PY%QUANTITY=='ENTHALPY')           .OR. &
                 (PY%QUANTITY=='PARTICLE FLUX X')    .OR. &
                 (PY%QUANTITY=='PARTICLE FLUX Y')    .OR. &
                 (PY%QUANTITY=='PARTICLE FLUX Z')) THEN
            EXPON = 1._EB
         ELSE
            EXPON = 1._EB/(PY%PDPA_M-PY%PDPA_N)
         ENDIF
         IF (.NOT.PY%PDPA_INTEGRATE) THEN
            DV%PDPA_NUMER = 0._EB
            DV%PDPA_DENUM = 0._EB
         ENDIF
         IF (PY%QUANTITY == 'NUMBER CONCENTRATION') DV%PDPA_DENUM = DV%PDPA_DENUM + FOTHPI*PY%PDPA_RADIUS**3
         IF (PY%QUANTITY == 'MASS CONCENTRATION' .OR. &
             PY%QUANTITY == 'ENTHALPY'           .OR. &
             PY%QUANTITY == 'PARTICLE FLUX X'     .OR. &
             PY%QUANTITY == 'PARTICLE FLUX Y'     .OR. &
             PY%QUANTITY == 'PARTICLE FLUX Z' ) THEN
             IF (PY%PDPA_NORMALIZE) THEN
                DV%PDPA_DENUM = DV%PDPA_DENUM + FOTHPI*(2._EB*PY%PDPA_RADIUS)**3
             ELSE
                DV%PDPA_DENUM = 8._EB
             ENDIF
         ENDIF
         DLOOP: DO I=1,NLP
            LP=>LAGRANGIAN_PARTICLE(I)
            LPC=>LAGRANGIAN_PARTICLE_CLASS(LP%CLASS_INDEX)
            IF (PY%PART_INDEX/=LP%CLASS_INDEX .AND. PY%PART_INDEX/=-1) CYCLE DLOOP
            IF ((LP%X-DV%X)**2+(LP%Y-DV%Y)**2+(LP%Z-DV%Z)**2 > PY%PDPA_RADIUS**2) CYCLE DLOOP
            SELECT CASE(PY%QUANTITY)
               CASE('U-VELOCITY')
                  VEL = LP%U
               CASE('V-VELOCITY')
                  VEL = LP%V
               CASE('W-VELOCITY')
                  VEL = LP%W
               CASE('VELOCITY')
                  VEL = SQRT(LP%U**2 + LP%V**2 + LP%W**2)
               CASE('PARTICLE FLUX X')
                  VEL = LPC%FTPR*LP%U
               CASE('PARTICLE FLUX Y')
                  VEL = LPC%FTPR*LP%V
               CASE('PARTICLE FLUX Z')
                  VEL = LPC%FTPR*LP%W
               CASE('MASS CONCENTRATION')
                  VEL = LPC%FTPR
               CASE('TEMPERATURE')
                  VEL = LP%ONE_D%TMP_F - TMPM
               CASE('ENTHALPY')
                  CALL INTERPOLATE1D_UNIFORM(LBOUND(SPECIES(LPC%Y_INDEX)%C_P_L_BAR,1),&
                                             SPECIES(LPC%Y_INDEX)%C_P_L_BAR,LP%ONE_D%TMP_F,CPBAR)
                  VEL = CPBAR*LP%ONE_D%TMP_F
                  !CALL INTERPOLATE1D_UNIFORM(LBOUND(SPECIES(LPC%Y_INDEX)%C_P_L_BAR,1),&
                  !                           SPECIES(LPC%Y_INDEX)%C_P_L_BAR,SPECIES(LPC%Y_INDEX)%TMP_MELT,CPBAR)
                  !VEL = VEL - CPBAR*SPECIES(LPC%Y_INDEX)%TMP_MELT
                  VEL = 0.001_EB*LPC%FTPR*VEL
               CASE DEFAULT
                  VEL = 1.0_EB
            END SELECT
            ! Compute numerator and denumerator
            DV%PDPA_NUMER = DV%PDPA_NUMER + LP%PWT*(2._EB*MAXVAL(LP%ONE_D%X))**PY%PDPA_M * VEL
            IF (PY%PDPA_HISTOGRAM)  CALL UPDATE_HISTOGRAM(PY%PDPA_HISTOGRAM_NBINS,PY%PDPA_HISTOGRAM_LIMITS &
                                              ,DV%PDPA_HISTOGRAM_COUNTS,&
                                              (2._EB*MAXVAL(LP%ONE_D%X))**PY%PDPA_M * VEL,&
                                              LP%PWT*MAXVAL(LP%ONE_D%X)**PY%PDPA_N)

            IF ((PY%QUANTITY /= 'NUMBER CONCENTRATION') .AND. &
                (PY%QUANTITY /= 'MASS CONCENTRATION') .AND. &
                (PY%QUANTITY /= 'PARTICLE FLUX X') .AND. &
                (PY%QUANTITY /= 'PARTICLE FLUX Y') .AND. &
                (PY%QUANTITY /= 'PARTICLE FLUX Z') .AND. &
                (PY%QUANTITY /= 'ENTHALPY')) THEN
               DV%PDPA_DENUM = DV%PDPA_DENUM + LP%PWT*(2._EB*MAXVAL(LP%ONE_D%X))**PY%PDPA_N
            ENDIF
         ENDDO DLOOP
         IF (DV%PDPA_DENUM > 0._EB) GAS_PHASE_OUTPUT_RES = (DV%PDPA_NUMER/DV%PDPA_DENUM)**EXPON
      ENDIF
   CASE(251)  ! WIND CHILL INDEX
      ! Wind speed at head height m/s, temperature Celsius
      ! WCT = 13.12 + 0.6215*TMP_G - 13.956*VEL_10m**(0.16) + 0.4867*TMP_G*VEL_10m**(0.16)
      ! Canada: Speed at head height = 2/3 * speed at 10 m height, v_10m = 1.5*v_head
      TMP_G = TMP(II,JJ,KK) - TMPM ! Temperature as Celsius
      VEL = 1.5_EB*SQRT(2._EB*KRES(II,JJ,KK)) ! Flow (wind) speed as m/s at 10 m height
      GAS_PHASE_OUTPUT_RES = MIN(13.12_EB+0.6215_EB*TMP_G-13.956_EB*VEL**(0.16_EB)+0.4867_EB*TMP_G*VEL**(0.16_EB),TMP_G)

   CASE(500)  ! PRESSURE MMS
      XHAT = XC(II) - UF_MMS*T
      ZHAT = ZC(KK) - WF_MMS*T
      GAS_PHASE_OUTPUT_RES = VD2D_MMS_P_3(XHAT,ZHAT,T)
   CASE(501)  ! H MMS
      XHAT = XC(II) - UF_MMS*T
      ZHAT = ZC(KK) - WF_MMS*T
      GAS_PHASE_OUTPUT_RES = VD2D_MMS_H_3(XHAT,ZHAT,T)
   CASE(502)  ! CHI_R
      GAS_PHASE_OUTPUT_RES = CHI_R(II,JJ,KK)
   CASE(503)  ! AUTO IGNITION TEMPERATURE
      TIME_RAMP_FACTOR = EVALUATE_RAMP(T,0._EB,REACTION(REAC_INDEX)%RAMP_AIT_INDEX)
      IF (REIGNITION_MODEL) THEN
         IF (AIT(II,JJ,KK) < 1.E10_EB) THEN
            GAS_PHASE_OUTPUT_RES = TIME_RAMP_FACTOR*AIT(II,JJ,KK) - TMPM
         ELSE
            GAS_PHASE_OUTPUT_RES = TIME_RAMP_FACTOR*REACTION(REAC_INDEX)%AUTO_IGNITION_TEMPERATURE - TMPM
         ENDIF
      ELSE
         GAS_PHASE_OUTPUT_RES = TIME_RAMP_FACTOR*REACTION(REAC_INDEX)%AUTO_IGNITION_TEMPERATURE - TMPM
      ENDIF

   CASE(504)  ! CFL 1
      IF (SOLID(CELL_INDEX(II,JJ,KK))) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         UODX = MAXVAL(ABS(US(II-1:II,JJ,KK)))*RDX(II)
         VODY = MAXVAL(ABS(VS(II,JJ-1:JJ,KK)))*RDY(JJ)
         WODZ = MAXVAL(ABS(WS(II,JJ,KK-1:KK)))*RDZ(KK)
         UVW = UODX + VODY + WODZ  + ABS(DS(II,JJ,KK)) ! CFL_VELOCITY_NORM=1
         GAS_PHASE_OUTPUT_RES = DT*UVW
      ENDIF
   CASE(505)  ! CFL 3
      IF (SOLID(CELL_INDEX(II,JJ,KK))) THEN
         GAS_PHASE_OUTPUT_RES = 0._EB
      ELSE
         UODX = MAXVAL(ABS(US(II-1:II,JJ,KK)))*RDX(II)
         VODY = MAXVAL(ABS(VS(II,JJ-1:JJ,KK)))*RDY(JJ)
         WODZ = MAXVAL(ABS(WS(II,JJ,KK-1:KK)))*RDZ(KK)
         UVW = MAX(UODX,VODY,WODZ)                     ! CFL_VELOCITY_NORM=3
         GAS_PHASE_OUTPUT_RES = DT*UVW
      ENDIF

   CASE(508)  ! IDEAL GAS PRESSURE
      ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(II,JJ,KK,1:N_TRACKED_SPECIES)
      CALL GET_SPECIFIC_GAS_CONSTANT(ZZ_GET,RCON)
      GAS_PHASE_OUTPUT_RES = RHO(II,JJ,KK)*RCON*TMP(II,JJ,KK)

   CASE(510)  ! DUDT
      GAS_PHASE_OUTPUT_RES = (U(II,JJ,KK)-U_OLD(II,JJ,KK))/DT

   CASE(511)  ! DVDT
      GAS_PHASE_OUTPUT_RES = (V(II,JJ,KK)-V_OLD(II,JJ,KK))/DT

   CASE(512)  ! DWDT
      GAS_PHASE_OUTPUT_RES = (W(II,JJ,KK)-W_OLD(II,JJ,KK))/DT

   CASE(520)  ! SOLID CELL Q_S
      OB => OBSTRUCTION(OBST_INDEX_C(CELL_INDEX(II,JJ,KK)))
      TIME_RAMP_FACTOR = EVALUATE_RAMP(T,0._EB,OB%RAMP_Q_INDEX)
      GAS_PHASE_OUTPUT_RES = TIME_RAMP_FACTOR * Q_DOT_PPP_S(II,JJ,KK) * 0.001_EB

   CASE(521)  ! SOLID CELL DENSITY
      GAS_PHASE_OUTPUT_RES = 0._EB
      OB => OBSTRUCTION(OBST_INDEX_C(CELL_INDEX(II,JJ,KK)))
      IF (OB%MATL_INDEX>0) THEN
         GAS_PHASE_OUTPUT_RES = MATERIAL(OB%MATL_INDEX)%RHO_S
      ELSEIF (OB%MATL_SURF_INDEX>0) THEN
         RHO_S = 0._EB
         SF => SURFACE(OB%MATL_SURF_INDEX)
         DO NN=1,SF%N_MATL
            MATL_INDEX_IF: IF (MATL_INDEX<=0) THEN
               ! if no MATL_ID is specified, output total density
               RHO_S = RHO_S + OB%RHO(II,JJ,KK,NN)
            ELSEIF (SF%MATL_INDEX(NN)==MATL_INDEX) THEN
               ! check original material layer
               GAS_PHASE_OUTPUT_RES = OB%RHO(II,JJ,KK,NN)
               RETURN
            ENDIF MATL_INDEX_IF
         ENDDO
         GAS_PHASE_OUTPUT_RES = RHO_S
      ENDIF
   CASE(522)  ! SOLID CELL VOLUME RATIO
      GAS_PHASE_OUTPUT_RES = 0._EB
      OB => OBSTRUCTION(OBST_INDEX_C(CELL_INDEX(II,JJ,KK)))
      IF (OB%MATL_SURF_INDEX>0) THEN
         SF => SURFACE(OB%MATL_SURF_INDEX)
         IF (TWO_D) THEN
            VC = DX(II)*DZ(KK)
         ELSE
            VC = DX(II)*DY(JJ)*DZ(KK)
         ENDIF

         DO NN=1,SF%N_MATL
            ML => MATERIAL(SF%MATL_INDEX(NN))
            GAS_PHASE_OUTPUT_RES = GAS_PHASE_OUTPUT_RES + OB%RHO(II,JJ,KK,NN)/ML%RHO_S
         ENDDO
      ENDIF
   CASE(523)  ! ABSOLUTE PRESSURE
      GAS_PHASE_OUTPUT_RES  = PBAR(KK,PRESSURE_ZONE(II,JJ,KK)) + RHO(II,JJ,KK)*(H(II,JJ,KK)-KRES(II,JJ,KK))

END SELECT IND_SELECT

END FUNCTION GAS_PHASE_OUTPUT


REAL(EB) FUNCTION SOLID_PHASE_OUTPUT(NM,INDX,Y_INDEX,Z_INDEX,PART_INDEX,OPT_WALL_INDEX,OPT_LP_INDEX,OPT_CFACE_INDEX)

! Compute Solid Phase DEVICE Output Quantities

USE PHYSICAL_FUNCTIONS, ONLY: SURFACE_DENSITY,GET_MASS_FRACTION,GET_SENSIBLE_ENTHALPY
USE MATH_FUNCTIONS, ONLY: EVALUATE_RAMP
USE TURBULENCE, ONLY: TAU_WALL_IJ
USE COMPLEX_GEOMETRY, ONLY : GET_PRES_CFACE, GET_PRES_CFACE_TEST, GET_UVWGAS_CFACE, GET_MUDNS_CFACE
INTEGER, INTENT(IN), OPTIONAL :: OPT_WALL_INDEX,OPT_LP_INDEX,OPT_CFACE_INDEX
INTEGER, INTENT(IN) :: INDX,Y_INDEX,Z_INDEX,PART_INDEX,NM
REAL(EB) :: CONCORR,VOLSUM,MFT,ZZ_GET(1:N_TRACKED_SPECIES),Y_SPECIES,DEPTH,UN,H_S,RHO_D_DYDN,U_CELL,V_CELL,W_CELL,&
            AAA,BBB,CCC,ALP,BET,GAM,MMM,X0,X1,XC0,XC1,TMP_BAR,VOL,DVOL,DN,PRESS,&
            NVEC(3),PVEC(3),TAU_IJ(3,3),VEL_CELL(3),VEL_WALL(3),MU_WALL,RHO_WALL,FVEC(3),SVEC(3),TVEC1(3),TVEC2(3),&
            P1,P2,Z1,Z2
INTEGER :: II1,II2,IIG,JJG,KKG,NN,NR,IWX,SURF_INDEX,I,J,K,IW,II,JJ,KK,NWP,IOR,M_INDEX,ICC,IND1,IND2,IC2
TYPE(WALL_TYPE), POINTER :: WC=>NULL()
TYPE(CFACE_TYPE), POINTER :: CFA=>NULL()
TYPE(LAGRANGIAN_PARTICLE_TYPE), POINTER :: LP=>NULL()
TYPE(ONE_D_M_AND_E_XFER_TYPE), POINTER :: ONE_D=>NULL()

IF (PRESENT(OPT_WALL_INDEX)) THEN

   IF (OPT_WALL_INDEX==0) THEN
      SOLID_PHASE_OUTPUT = OUTPUT_QUANTITY(-INDX)%AMBIENT_VALUE
      RETURN
   ENDIF
   IWX = OPT_WALL_INDEX
   WC=>WALL(IWX)
   SURF_INDEX = WC%SURF_INDEX
   ONE_D => WC%ONE_D
   IF (WC%BOUNDARY_TYPE==NULL_BOUNDARY) THEN
      SOLID_PHASE_OUTPUT = OUTPUT_QUANTITY(-INDX)%AMBIENT_VALUE
      RETURN
   ENDIF

ELSEIF (PRESENT(OPT_LP_INDEX)) THEN

   LP => LAGRANGIAN_PARTICLE(OPT_LP_INDEX + DV%ORIENTATION_NUMBER - 1)
   ONE_D => LP%ONE_D
   SURF_INDEX = LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)%SURF_INDEX

ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN

   CFA => CFACE(OPT_CFACE_INDEX)
   SURF_INDEX = CFA%SURF_INDEX
   ONE_D => CFA%ONE_D

ENDIF

! Find the appropriate solid phase output quantity

SOLID_PHASE_SELECT: SELECT CASE(INDX)
   CASE( 1) ! RADIATIVE HEAT FLUX
      SOLID_PHASE_OUTPUT = (ONE_D%QRADIN-ONE_D%QRADOUT)*0.001_EB
   CASE( 2) ! CONVECTIVE HEAT FLUX
      SOLID_PHASE_OUTPUT = ONE_D%QCONF*0.001_EB
   CASE( 3) ! NORMAL VELOCITY
      SOLID_PHASE_OUTPUT = ONE_D%UW
   CASE( 4) ! GAS TEMPERATURE
      SOLID_PHASE_OUTPUT = ONE_D%TMP_G - TMPM
   CASE( 5) ! WALL TEMPERATURE
      SOLID_PHASE_OUTPUT = ONE_D%TMP_F - TMPM
   CASE( 6) ! INSIDE WALL TEMPERATURE
      IF (ABS(SUM(ONE_D%LAYER_THICKNESS)-SUM(SURFACE(SURF_INDEX)%LAYER_THICKNESS))>TWO_EPSILON_EB) THEN
         IF (DV%DEPTH > TWO_EPSILON_EB) THEN
            DEPTH = DV%DEPTH
         ELSE
            DEPTH = MAX(0._EB,SUM(ONE_D%LAYER_THICKNESS)+DV%DEPTH)
         ENDIF
         II2 = SUM(ONE_D%N_LAYER_CELLS)
         IF (DEPTH>SUM(ONE_D%LAYER_THICKNESS)) THEN
            SOLID_PHASE_OUTPUT = TMPA-TMPM
         ELSE
            DO II2=II2,1,-1
               IF (DEPTH<=ONE_D%X(II2)) II1 = II2
            ENDDO
            SOLID_PHASE_OUTPUT = ONE_D%TMP(II1) - TMPM
         ENDIF
      ELSE
         SOLID_PHASE_OUTPUT = ONE_D%TMP(DV%I_DEPTH) - TMPM
      ENDIF
   CASE( 7) ! BURNING RATE
      IF (N_REACTIONS>0) THEN
         SOLID_PHASE_OUTPUT = ONE_D%MASSFLUX_SPEC(REACTION(1)%FUEL_SMIX_INDEX)
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF
   CASE( 8) ! NORMALIZED HEAT RELEASE RATE
      SOLID_PHASE_OUTPUT = ONE_D%MASSFLUX(REACTION(1)%FUEL_SMIX_INDEX)*0.001*REACTION(1)%HEAT_OF_COMBUSTION/ &
                           (SURFACE(SURF_INDEX)%SURFACE_DENSITY*ONE_D%AREA_ADJUST)
   CASE( 9) ! HRRPUA
      SOLID_PHASE_OUTPUT = ONE_D%MASSFLUX(REACTION(1)%FUEL_SMIX_INDEX)*0.001*REACTION(1)%HEAT_OF_COMBUSTION
   CASE(10) ! NET HEAT FLUX
      SOLID_PHASE_OUTPUT = (ONE_D%QRADIN-ONE_D%QRADOUT+ONE_D%QCONF)*0.001_EB
   CASE(11) ! PRESSURE COEFFICIENT
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         IIG = ONE_D%IIG
         JJG = ONE_D%JJG
         KKG = ONE_D%KKG
         PRESS = ONE_D%RHO_G*(H(IIG,JJG,KKG)-KRES(IIG,JJG,KKG))
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         IND1 = CFA%CUT_FACE_IND1
         IND2 = CFA%CUT_FACE_IND2
         CALL GET_PRES_CFACE(PRESS,IND1,IND2,ONE_D)
      ENDIF
      SOLID_PHASE_OUTPUT = PRESS/(0.5_EB*RHOA*PY%CHARACTERISTIC_VELOCITY**2)
   CASE(12) ! BACK WALL TEMPERATURE
      SOLID_PHASE_OUTPUT = ONE_D%TMP_B - TMPM
   CASE(13) ! GAUGE HEAT FLUX
      CONCORR = ONE_D%HEAT_TRANS_COEF*(ONE_D%TMP_F-PY%GAUGE_TEMPERATURE)
      SOLID_PHASE_OUTPUT = (PY%GAUGE_EMISSIVITY*(ONE_D%QRADIN/(ONE_D%EMISSIVITY+1.0E-10_EB) - SIGMA*PY%GAUGE_TEMPERATURE**4) + &
                            ONE_D%QCONF + CONCORR)*0.001_EB
   CASE(14) ! NORMALIZED HEATING RATE
      SOLID_PHASE_OUTPUT = ONE_D%QCONF*0.001_EB/SURFACE(SURF_INDEX)%SURFACE_DENSITY
   CASE(15,16) ! MASS FLUX, NORMALIZED MASS LOSS RATE
      IF (Z_INDEX >=0) THEN
         SOLID_PHASE_OUTPUT = ONE_D%MASSFLUX_SPEC(Z_INDEX)
      ELSEIF (Y_INDEX > 0) THEN
         SOLID_PHASE_OUTPUT = 0._EB
         MFT = SUM(ONE_D%MASSFLUX_SPEC)
         IF (MFT>TWO_EPSILON_EB) THEN
            ZZ_GET = ONE_D%MASSFLUX_SPEC/MFT
            CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
            SOLID_PHASE_OUTPUT = Y_SPECIES*MFT
         ENDIF
      ELSEIF (DV%MATL_ID/='null') THEN
         SF => SURFACE(SURF_INDEX)
         DO NN=1,SF%N_MATL
            IF (DV%MATL_ID==SF%MATL_NAME(NN)) THEN
               M_INDEX = NN
               EXIT
            ENDIF
         ENDDO
         SOLID_PHASE_OUTPUT = ONE_D%MASSFLUX_MATL(M_INDEX)
      ELSE
         SOLID_PHASE_OUTPUT = SUM(ONE_D%MASSFLUX_SPEC(:))
      ENDIF
      IF (INDX==16) SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT/SURFACE(SURF_INDEX)%SURFACE_DENSITY
   CASE(17) ! RADIANCE
      SOLID_PHASE_OUTPUT = SUM(ONE_D%IL(1:NUMBER_SPECTRAL_BANDS))*0.001_EB
   CASE(20) ! INCIDENT HEAT FLUX
      SOLID_PHASE_OUTPUT = ( ONE_D%QRADIN/(ONE_D%EMISSIVITY+1.0E-10_EB) )*0.001_EB
   CASE(21) ! HEAT TRANSFER COEFFICENT
      SOLID_PHASE_OUTPUT = ONE_D%HEAT_TRANS_COEF
   CASE(22) ! RADIOMETER
      SOLID_PHASE_OUTPUT = PY%GAUGE_EMISSIVITY*(ONE_D%QRADIN/(ONE_D%EMISSIVITY+1.0E-10_EB)-SIGMA*PY%GAUGE_TEMPERATURE**4)*0.001_EB

   CASE(23) ! ADIABATIC SURFACE TEMPERATURE
      IF (ONE_D%HEAT_TRANS_COEF>0._EB) THEN
         AAA = ONE_D%EMISSIVITY*SIGMA
         BBB = ONE_D%HEAT_TRANS_COEF
         CCC = -ONE_D%QRADIN - ONE_D%HEAT_TRANS_COEF*ONE_D%TMP_G
         ALP = (SR3*SQRT(27._EB*AAA**2*BBB**4-256._EB*AAA**3*CCC**3)+9._EB*AAA*BBB**2)**ONTH
         BET = FTTOT*CCC
         GAM = EIONTH*AAA
         MMM = SQRT(BET/ALP + ALP/GAM)
         SOLID_PHASE_OUTPUT = 0.5_EB*(-MMM+SQRT(2._EB*BBB/(AAA*MMM)-MMM**2)) - TMPM
      ELSE
         SOLID_PHASE_OUTPUT = (ONE_D%QRADIN/(ONE_D%EMISSIVITY*SIGMA))**0.25 - TMPM
      ENDIF

   CASE(24) ! WALL THICKNESS
      IF (SURFACE(SURF_INDEX)%THERMALLY_THICK) THEN
         SOLID_PHASE_OUTPUT = SUM(ONE_D%LAYER_THICKNESS)
      ELSE
         SOLID_PHASE_OUTPUT = 0._EB
      ENDIF

      IF (SURFACE(SURF_INDEX)%VEGETATION) THEN     !surface vegetation height
         SOLID_PHASE_OUTPUT = WC%VEG_HEIGHT
      ENDIF

   CASE(25,26) ! SURFACE DENSITY, NORMALIZED MASS
      SF => SURFACE(SURF_INDEX)
      IF (DV%MATL_ID/='null') THEN
         DO NN=1,SF%N_MATL
            IF (DV%MATL_ID==SF%MATL_NAME(NN)) THEN
               M_INDEX = NN
               EXIT
            ENDIF
         ENDDO
         SOLID_PHASE_OUTPUT = SURFACE_DENSITY(NM,0,WALL_INDEX=IWX,MATL_INDEX=M_INDEX)
      ELSE
         SOLID_PHASE_OUTPUT = SURFACE_DENSITY(NM,0,WALL_INDEX=IWX)
      ENDIF
      IF (INDX==26) SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT/SF%SURFACE_DENSITY

   CASE(27) ! SOLID DENSITY
      SF => SURFACE(SURF_INDEX)
      II1 = DV%I_DEPTH
      IF (SF%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED) THEN
         IF (DV%DEPTH > TWO_EPSILON_EB) THEN
            DEPTH = DV%DEPTH
         ELSE
            DEPTH = MAX(0._EB,SUM(ONE_D%LAYER_THICKNESS)+DV%DEPTH)
         ENDIF
         II2 = SUM(ONE_D%N_LAYER_CELLS)
         IF (DEPTH>SUM(ONE_D%LAYER_THICKNESS)) THEN
            SOLID_PHASE_OUTPUT = 0._EB
            RETURN
         ELSE
            DO II2=II2,1,-1
               IF (DEPTH<=ONE_D%X(II2)) II1 = II2
            ENDDO
         ENDIF
      ENDIF
      DO NN=1,SF%N_MATL
         IF (DV%MATL_ID==SF%MATL_NAME(NN)) THEN
            SOLID_PHASE_OUTPUT = ONE_D%MATL_COMP(NN)%RHO(II1)
            RETURN
         ENDIF
      ENDDO
      SOLID_PHASE_OUTPUT = 0._EB

   CASE(28) ! EMISSIVITY
      SOLID_PHASE_OUTPUT = ONE_D%EMISSIVITY

   CASE(29) ! SURFACE DEPOSITION
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         IF (Z_INDEX>0) SOLID_PHASE_OUTPUT = WC%AWM_AEROSOL(SPECIES_MIXTURE(Z_INDEX)%AWM_INDEX)
         IF (Y_INDEX>0) SOLID_PHASE_OUTPUT = WC%AWM_AEROSOL(SPECIES(Y_INDEX)%AWM_INDEX)
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         IF (Z_INDEX>0) SOLID_PHASE_OUTPUT = CFA%AWM_AEROSOL(SPECIES_MIXTURE(Z_INDEX)%AWM_INDEX)
         IF (Y_INDEX>0) SOLID_PHASE_OUTPUT = CFA%AWM_AEROSOL(SPECIES(Y_INDEX)%AWM_INDEX)
      ENDIF

   CASE(30) ! MPUA
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      SOLID_PHASE_OUTPUT = WC%LP_MPUA(LPC%ARRAY_INDEX)

   CASE(31) ! CPUA
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      SOLID_PHASE_OUTPUT =  WC%LP_CPUA(LPC%ARRAY_INDEX)*0.001_EB

   CASE(32) ! AMPUA
      LPC => LAGRANGIAN_PARTICLE_CLASS(PART_INDEX)
      SOLID_PHASE_OUTPUT = WC%A_LP_MPUA(LPC%ARRAY_INDEX)

   CASE(33) ! SOLID SPECIFIC HEAT
      SF => SURFACE(SURF_INDEX)
      II1 = DV%I_DEPTH
      IF (SF%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED) THEN
         IF (DV%DEPTH > TWO_EPSILON_EB) THEN
            DEPTH = DV%DEPTH
         ELSE
            DEPTH = MAX(0._EB,SUM(ONE_D%LAYER_THICKNESS)+DV%DEPTH)
         ENDIF
         II2 = SUM(ONE_D%N_LAYER_CELLS)
         IF (DEPTH>SUM(ONE_D%LAYER_THICKNESS)) THEN
            SOLID_PHASE_OUTPUT = 0._EB
            RETURN
         ELSE
            DO II2=II2,1,-1
               IF (DEPTH<=ONE_D%X(II2)) II1 = II2
            ENDDO
         ENDIF
      ENDIF
      VOLSUM = 0._EB
      MATERIAL_LOOP_CP: DO NN=1,SF%N_MATL
         IF (ONE_D%MATL_COMP(NN)%RHO(II1)<=TWO_EPSILON_EB) CYCLE MATERIAL_LOOP_CP
         ML  => MATERIAL(SF%MATL_INDEX(NN))
         VOLSUM = VOLSUM + ONE_D%MATL_COMP(NN)%RHO(II1)/ML%RHO_S
         IF (ML%C_S>0._EB) THEN
            SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + ONE_D%MATL_COMP(NN)%RHO(II1)*ML%C_S/ML%RHO_S
         ELSE
            NR     = -NINT(ML%C_S)
            SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + ONE_D%MATL_COMP(NN)%RHO(II1)*EVALUATE_RAMP(ONE_D%TMP(II1),0._EB,NR)/ML%RHO_S
         ENDIF
      ENDDO MATERIAL_LOOP_CP
      SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT / VOLSUM * 0.001_EB

   CASE(34) ! SOLID CONDUCTIVITY
      SF => SURFACE(SURF_INDEX)
      II1 = DV%I_DEPTH
      IF (SF%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED) THEN
         IF (DV%DEPTH > TWO_EPSILON_EB) THEN
            DEPTH = DV%DEPTH
         ELSE
            DEPTH = MAX(0._EB,SUM(ONE_D%LAYER_THICKNESS)+DV%DEPTH)
         ENDIF
         II2 = SUM(ONE_D%N_LAYER_CELLS)
         IF (DEPTH>SUM(ONE_D%LAYER_THICKNESS)) THEN
            SOLID_PHASE_OUTPUT = 0._EB
            RETURN
         ELSE
            DO II2=II2,1,-1
               IF (DEPTH<=ONE_D%X(II2)) II1 = II2
            ENDDO
         ENDIF
      ENDIF
      VOLSUM = 0._EB
      MATERIAL_LOOP_K: DO NN=1,SF%N_MATL
         IF (ONE_D%MATL_COMP(NN)%RHO(II1)<=TWO_EPSILON_EB) CYCLE MATERIAL_LOOP_K
         ML => MATERIAL(SF%MATL_INDEX(NN))
         VOLSUM = VOLSUM + ONE_D%MATL_COMP(NN)%RHO(II1)/ML%RHO_S
         IF (ML%K_S>0._EB) THEN
            SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + ONE_D%MATL_COMP(NN)%RHO(II1)*ML%K_S/ML%RHO_S
         ELSE
            NR = -NINT(ML%K_S)
            SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + ONE_D%MATL_COMP(NN)%RHO(II1)*EVALUATE_RAMP(ONE_D%TMP(II1),0._EB,NR)/ML%RHO_S
         ENDIF
      ENDDO MATERIAL_LOOP_K
      SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT / VOLSUM

   CASE(35) ! VISCOUS WALL UNITS (distance from the wall expressed in nondimensional viscous units)
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         SOLID_PHASE_OUTPUT = WC%ONE_D%Y_PLUS
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         SOLID_PHASE_OUTPUT = CFA%ONE_D%Y_PLUS
      ENDIF

   CASE(36) ! FRICTION VELOCITY
      SOLID_PHASE_OUTPUT = WC%ONE_D%U_TAU

   CASE(37) ! VELOCITY ERROR
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         SOLID_PHASE_OUTPUT = WC%VEL_ERR_NEW
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         SOLID_PHASE_OUTPUT = CFA%VEL_ERR_NEW
      ENDIF

   CASE(38) ! WALL VISCOSITY
      SOLID_PHASE_OUTPUT = ONE_D%MU_G

   CASE(39) ! DEPOSITION VELOCITY
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         SOLID_PHASE_OUTPUT = WC%V_DEP
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         SOLID_PHASE_OUTPUT = CFA%V_DEP
      ENDIF

   CASE(41) ! WALL CELL COLOR (output VENT index for WC color)
      SOLID_PHASE_OUTPUT = REAL(WC%VENT_INDEX,EB)

   CASE(42) ! MPUA_Z
      SOLID_PHASE_OUTPUT = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         IF (LAGRANGIAN_PARTICLE_CLASS(NN)%LIQUID_DROPLET) THEN
            IF (LAGRANGIAN_PARTICLE_CLASS(NN)%Y_INDEX==Y_INDEX) &
               SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + WC%LP_MPUA(LAGRANGIAN_PARTICLE_CLASS(NN)%ARRAY_INDEX)
         ENDIF
      ENDDO

   CASE(43) ! CPUA_Z
      SOLID_PHASE_OUTPUT = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) &
            SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + WC%LP_CPUA(LPC%ARRAY_INDEX)*0.001_EB
      ENDDO

   CASE(44) ! AMPUA_Z
      SOLID_PHASE_OUTPUT = 0._EB
      DO NN = 1,N_LAGRANGIAN_CLASSES
         LPC => LAGRANGIAN_PARTICLE_CLASS(NN)
         IF (LPC%LIQUID_DROPLET .AND. LPC%Y_INDEX==Y_INDEX) &
            SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + WC%A_LP_MPUA(LPC%ARRAY_INDEX)
      ENDDO

   CASE(45) ! WALL CELL BOUNDARY TYPE (debug)
      SOLID_PHASE_OUTPUT = REAL(WC%BOUNDARY_TYPE,EB)

   CASE(46) ! WALL CELL THERMAL BOUNDARY TYPE (debug)
      SF => SURFACE(SURF_INDEX)
      SOLID_PHASE_OUTPUT = REAL(SF%THERMAL_BC_INDEX,EB)

   CASE(47) ! INSIDE WALL DEPTH (for use with INSIDE WALL TEMPERATURE to obtain exact TMP location)
      IF (ABS(SUM(ONE_D%LAYER_THICKNESS)-SUM(SURFACE(SURF_INDEX)%LAYER_THICKNESS))>TWO_EPSILON_EB) THEN
         IF (DV%DEPTH > TWO_EPSILON_EB) THEN
            DEPTH = DV%DEPTH
         ELSE
            DEPTH = MAX(0._EB,SUM(ONE_D%LAYER_THICKNESS)+DV%DEPTH)
         ENDIF
         II2 = SUM(ONE_D%N_LAYER_CELLS)
         IF (DEPTH>SUM(ONE_D%LAYER_THICKNESS)) THEN
            SOLID_PHASE_OUTPUT = DEPTH
         ELSE
            DO II2=II2,1,-1
               IF (DEPTH<=ONE_D%X(II2)) II1 = II2
            ENDDO
            SOLID_PHASE_OUTPUT = 0.5_EB*( ONE_D%X(II1-1) + ONE_D%X(II1) )
         ENDIF
      ELSE
         SOLID_PHASE_OUTPUT = 0.5_EB*( ONE_D%X(DV%I_DEPTH-1) + ONE_D%X(DV%I_DEPTH) )
      ENDIF

   CASE(50:58) ! VOLUME FLOW WALL, MASS FLOW WALL, HEAT FLOW WALL
      SOLID_PHASE_OUTPUT = 0._EB
      DV_K_LOOP: DO K=SDV%K1,SDV%K2
         DV_J_LOOP: DO J=SDV%J1,SDV%J2
            DV_I_LOOP: DO I=SDV%I1,SDV%I2
               IIG=I
               JJG=J
               KKG=K
               SELECT CASE(DV%IOR)
                  ! convention here is: inflow is positive (adds mass to domain), outflow is negative (subtracts mass)
                  CASE( 1); UN =  U(I,J,K); IIG=IIG+1
                  CASE(-1); UN = -U(I,J,K)
                  CASE( 2); UN =  V(I,J,K); JJG=JJG+1
                  CASE(-2); UN = -V(I,J,K)
                  CASE( 3); UN =  W(I,J,K); KKG=KKG+1
                  CASE(-3); UN = -W(I,J,K)
               END SELECT
               IW = WALL_INDEX(CELL_INDEX(IIG,JJG,KKG),-DV%IOR)
               IF (IW==0) CYCLE DV_I_LOOP
               WC => WALL(IW)
               SELECT CASE(INDX)
                  CASE DEFAULT
                  CASE (51,54,57)
                     UN = MAX(0._EB,UN) ! +
                  CASE (52,55,58)
                     UN = MIN(0._EB,UN) ! -
               END SELECT
               SELECT CASE(INDX)
                  CASE(50,51,52) ! VOLUME FLOW WALL (+,-)
                     SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + UN*WC%ONE_D%AREA
                  CASE(53,54,55) ! MASS FLOW WALL (+,-)
                     IF (Z_INDEX > 0) THEN
                        Y_SPECIES = ONE_D%ZZ_F(Z_INDEX)
                     ELSEIF (Y_INDEX > 0) THEN
                        ZZ_GET(1:N_TRACKED_SPECIES) = ONE_D%ZZ_F(1:N_TRACKED_SPECIES)
                        CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
                     ELSE
                        Y_SPECIES = 1._EB
                     ENDIF
                     SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + Y_SPECIES*ONE_D%RHO_F*UN*WC%ONE_D%AREA
                  CASE(56,57,58) ! HEAT FLOW WALL (+,-)
                     ZZ_GET(1:N_TRACKED_SPECIES) = ONE_D%ZZ_F(1:N_TRACKED_SPECIES)
                     CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,ONE_D%TMP_F)
                     SOLID_PHASE_OUTPUT = SOLID_PHASE_OUTPUT + ONE_D%RHO_F*H_S*UN*WC%ONE_D%AREA*0.001_EB
               END SELECT
            ENDDO DV_I_LOOP
         ENDDO DV_J_LOOP
      ENDDO DV_K_LOOP

   CASE(61) ! GAS DENSITY
      IF (Z_INDEX > 0) THEN
         Y_SPECIES = ONE_D%ZZ_G(Z_INDEX)
      ELSEIF (Y_INDEX > 0) THEN
         ZZ_GET(1:N_TRACKED_SPECIES) = ONE_D%ZZ_G(1:N_TRACKED_SPECIES)
         CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
      ELSE
         Y_SPECIES = 1._EB
      ENDIF
      SOLID_PHASE_OUTPUT = ONE_D%RHO_G*Y_SPECIES

   CASE(62) ! SOLID CELL TEMPERATURE

      !              X(II-1)      X(II)      X(IIG-1)
      !                XC1         XC0        //|
      !     |           |    II     |         //| <= 3D CELL INDEX, VOL=XC1-XC0
      !     |     o     |     o     |     o   //| <= WALL CELL (WC)
      !     |.................................//| <= ONE_D%X, dx
      !
      !     TMP_BAR = 1/VOL * INT_XC0^XC1 ONE_D%TMP * dx

      II  = DV%I
      JJ  = DV%J
      KK  = DV%K
      IIG = ONE_D%IIG
      JJG = ONE_D%JJG
      KKG = ONE_D%KKG
      IOR = ONE_D%IOR
      NWP = SUM(ONE_D%N_LAYER_CELLS)

      SELECT CASE(IOR)
         CASE (1)
            XC0 = X(IIG-1) - X(II)
            XC1 = X(IIG-1) - X(II-1)
         CASE (-1)
            XC0 = X(II-1)  - X(IIG)
            XC1 = X(II)    - X(IIG)
         CASE (2)
            XC0 = Y(JJG-1) - Y(JJ)
            XC1 = Y(JJG-1) - Y(JJ-1)
         CASE (-2)
            XC0 = Y(JJ-1)  - Y(JJG)
            XC1 = Y(JJ)    - Y(JJG)
         CASE (3)
            XC0 = Z(KKG-1) - Z(KK)
            XC1 = Z(KKG-1) - Z(KK-1)
         CASE (-3)
            XC0 = Z(KK-1)  - Z(KKG)
            XC1 = Z(KK)    - Z(KKG)
      END SELECT

      TMP_BAR = 0._EB
      VOL = 0._EB
      DO I=1,NWP
         X0 = ONE_D%X(I-1); IF (X0>XC1) EXIT
         X1 = ONE_D%X(I)  ; IF (X1<XC0) CYCLE
         DVOL = MIN(X1,XC1) - MAX(X0,XC0)
         TMP_BAR = TMP_BAR + ONE_D%TMP(I) * DVOL
         VOL = VOL + DVOL
      ENDDO
      IF (VOL>TWO_EPSILON_EB) TMP_BAR = TMP_BAR/VOL

      SOLID_PHASE_OUTPUT = TMP_BAR - TMPM

   CASE(63) ! THERMAL WALL UNITS
      SOLID_PHASE_OUTPUT = ONE_D%Z_STAR

   CASE(64) ! MASS FLUX WALL
      IIG = ONE_D%IIG
      JJG = ONE_D%JJG
      KKG = ONE_D%KKG
      UN  = -ONE_D%UW
      IF (Z_INDEX > 0) THEN
         Y_SPECIES = ONE_D%ZZ_F(Z_INDEX)
         RHO_D_DYDN = ONE_D%RHO_D_DZDN_F(Z_INDEX)
      ELSEIF (Y_INDEX > 0) THEN
         ZZ_GET(1:N_TRACKED_SPECIES) = ONE_D%ZZ_F(1:N_TRACKED_SPECIES)
         CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
         RHO_D_DYDN = DOT_PRODUCT(Z2Y(Y_INDEX,1:N_TRACKED_SPECIES),ONE_D%RHO_D_DZDN_F(1:N_TRACKED_SPECIES))
      ELSE
         Y_SPECIES = 1._EB
         RHO_D_DYDN = 0._EB
      ENDIF
      ! convention here is: inflow is positive (adds mass to domain), outflow is negative (subtracts mass)
      SOLID_PHASE_OUTPUT = Y_SPECIES*ONE_D%RHO_F*UN - RHO_D_DYDN

   CASE(65) ! WALL PRESSURE (takes optional IOR or ORIENTATION vector)
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         IIG = ONE_D%IIG
         JJG = ONE_D%JJG
         KKG = ONE_D%KKG
         ! quadratic extrapolation to surface pressure
         P1 = ONE_D%RHO_G*(H(IIG,JJG,KKG)-KRES(IIG,JJG,KKG))
         P2 = P1
         SELECT CASE(ONE_D%IOR)
            CASE( 1)
               NVEC=(/ 1._EB,0._EB,0._EB/)
               Z1 = 0.5_EB*DX(IIG)
               Z2 = DX(IIG)+0.5_EB*DX(IIG+1)
               IC2 = CELL_INDEX(IIG+1,JJG,KKG)
               IF (.NOT.SOLID(IC2)) P2 = ONE_D%RHO_G*(H(IIG+1,JJG,KKG)-KRES(IIG+1,JJG,KKG))
            CASE(-1)
               NVEC=(/-1._EB,0._EB,0._EB/)
               Z1 = 0.5_EB*DX(IIG)
               Z2 = DX(IIG)+0.5_EB*DX(IIG-1)
               IC2 = CELL_INDEX(IIG-1,JJG,KKG)
               IF (.NOT.SOLID(IC2)) P2 = ONE_D%RHO_G*(H(IIG-1,JJG,KKG)-KRES(IIG-1,JJG,KKG))
            CASE( 2)
               NVEC=(/0._EB, 1._EB,0._EB/)
               Z1 = 0.5_EB*DY(JJG)
               Z2 = DY(JJG)+0.5_EB*DY(JJG+1)
               IC2 = CELL_INDEX(IIG,JJG+1,KKG)
               IF (.NOT.SOLID(IC2)) P2 = ONE_D%RHO_G*(H(IIG,JJG+1,KKG)-KRES(IIG,JJG+1,KKG))
            CASE(-2)
               NVEC=(/0._EB,-1._EB,0._EB/)
               Z1 = 0.5_EB*DY(JJG)
               Z2 = DY(JJG)+0.5_EB*DY(JJG-1)
               IC2 = CELL_INDEX(IIG,JJG-1,KKG)
               IF (.NOT.SOLID(IC2)) P2 = ONE_D%RHO_G*(H(IIG,JJG-1,KKG)-KRES(IIG,JJG-1,KKG))
            CASE( 3)
               NVEC=(/0._EB,0._EB, 1._EB/)
               Z1 = 0.5_EB*DZ(KKG)
               Z2 = DZ(KKG)+0.5_EB*DZ(KKG+1)
               IC2 = CELL_INDEX(IIG,JJG,KKG+1)
               IF (.NOT.SOLID(IC2)) P2 = ONE_D%RHO_G*(H(IIG,JJG,KKG+1)-KRES(IIG,JJG,KKG+1))
            CASE(-3)
               NVEC=(/0._EB,0._EB,-1._EB/)
               Z1 = 0.5_EB*DZ(KKG)
               Z2 = DZ(KKG)+0.5_EB*DZ(KKG-1)
               IC2 = CELL_INDEX(IIG,JJG,KKG-1)
               IF (.NOT.SOLID(IC2)) P2 = ONE_D%RHO_G*(H(IIG,JJG,KKG-1)-KRES(IIG,JJG,KKG-1))
         END SELECT

         PVEC = ( P1 - (P2-P1)*Z1**2 / (Z2**2-Z1**2) ) * NVEC ! surface normal pressure force
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         NVEC = CFA%NVEC
         ! find cut-cell adjacent to CFACE
         IND1 = CFA%CUT_FACE_IND1
         IND2 = CFA%CUT_FACE_IND2
         CALL GET_PRES_CFACE(PRESS,IND1,IND2,ONE_D)
         PVEC = PRESS * NVEC ! surface normal pressure force
      ENDIF

      SOLID_PHASE_OUTPUT = DOT_PRODUCT(PVEC,NVEC)

      IF(FROM_BNDF) RETURN

      IF (ASSOCIATED(DV)) THEN
         IF (NORM2(DV%OVEC)>TWO_EPSILON_EB) THEN
            SOLID_PHASE_OUTPUT = -DOT_PRODUCT(PVEC,DV%OVEC)
         ENDIF
      ENDIF

   CASE(66) ! VISCOUS STRESS WALL (takes optional IOR or ORIENTATION vector)
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         SELECT CASE(ONE_D%IOR)
            ! note: VEL_T does not follow a right hand rule, see user guide
            CASE( 1); NVEC=(/ 1._EB,0._EB,0._EB/); TVEC1=(/ 0._EB,1._EB,0._EB/); TVEC2=(/ 0._EB,0._EB,1._EB/)
            CASE(-1); NVEC=(/-1._EB,0._EB,0._EB/); TVEC1=(/ 0._EB,1._EB,0._EB/); TVEC2=(/ 0._EB,0._EB,1._EB/)
            CASE( 2); NVEC=(/0._EB, 1._EB,0._EB/); TVEC1=(/ 1._EB,0._EB,0._EB/); TVEC2=(/ 0._EB,0._EB,1._EB/)
            CASE(-2); NVEC=(/0._EB,-1._EB,0._EB/); TVEC1=(/ 1._EB,0._EB,0._EB/); TVEC2=(/ 0._EB,0._EB,1._EB/)
            CASE( 3); NVEC=(/0._EB,0._EB, 1._EB/); TVEC1=(/ 1._EB,0._EB,0._EB/); TVEC2=(/ 0._EB,1._EB,0._EB/)
            CASE(-3); NVEC=(/0._EB,0._EB,-1._EB/); TVEC1=(/ 1._EB,0._EB,0._EB/); TVEC2=(/ 0._EB,1._EB,0._EB/)
         END SELECT
         IIG = ONE_D%IIG
         JJG = ONE_D%JJG
         KKG = ONE_D%KKG
         U_CELL = 0.5_EB*(U(IIG-1,JJG,KKG)+U(IIG,JJG,KKG))
         V_CELL = 0.5_EB*(V(IIG,JJG-1,KKG)+V(IIG,JJG,KKG))
         W_CELL = 0.5_EB*(W(IIG,JJG,KKG-1)+W(IIG,JJG,KKG))
         MU_WALL = MU_DNS(IIG,JJG,KKG)
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         NVEC = CFA%NVEC
         ! right now VEL_T not defined for CFACEs
         TVEC1=(/ 0._EB,0._EB,0._EB/)
         TVEC2=(/ 0._EB,0._EB,0._EB/)
         ! find cut-cell adjacent to CFACE
         IND1 = CFA%CUT_FACE_IND1
         IND2 = CFA%CUT_FACE_IND2
         CALL GET_UVWGAS_CFACE(U_CELL,V_CELL,W_CELL,IND1,IND2)
         CALL GET_MUDNS_CFACE(MU_WALL,IND1,IND2)
         ICC = CUT_FACE(IND1)%CELL_LIST(2,LOW_IND,IND2)
         IIG = CUT_CELL(ICC)%IJK(1)
         JJG = CUT_CELL(ICC)%IJK(2)
         KKG = CUT_CELL(ICC)%IJK(3)
      ENDIF

      DN  = 1._EB/ONE_D%RDN
      SF => SURFACE(SURF_INDEX)

      ! velocity vector in the centroid of the gas (cut) cell
      VEL_CELL = (/U_CELL,V_CELL,W_CELL/) ! (/1._EB,0._EB,0._EB/) ! test

      ! velocity vector of the surface
      VEL_WALL = -ONE_D%UW*NVEC + SF%VEL_T(1)*TVEC1 + SF%VEL_T(2)*TVEC2

      RHO_WALL = ONE_D%RHO_F

      CALL TAU_WALL_IJ(TAU_IJ,SVEC,VEL_CELL,VEL_WALL,NVEC,DN,D(IIG,JJG,KKG),MU_WALL,RHO_WALL,SF%ROUGHNESS)

      DO I=1,3
         FVEC(I) = DOT_PRODUCT(TAU_IJ(I,:),NVEC(:))
      ENDDO

      SOLID_PHASE_OUTPUT = DOT_PRODUCT(FVEC,SVEC)

      ! print *,'I,J,K: ',IIG,JJG,KKG
      ! print *,'V CELL: ',VEL_CELL
      ! print *,'V WALL: ',VEL_WALL
      ! print *,TAU_IJ(1,:)
      ! print *,TAU_IJ(2,:)
      ! print *,TAU_IJ(3,:)
      ! print *,TAU_IJ(1,1)+TAU_IJ(2,2)+TAU_IJ(3,3)
      ! print *
      ! print *,'NVEC: ',NVEC
      ! print *,'SVEC: ',SVEC
      ! print *,'FVEC: ',FVEC
      ! print *
      ! print *,'FS: ', SOLID_PHASE_OUTPUT
      ! print *

     IF(FROM_BNDF) RETURN

      IF (ASSOCIATED(DV)) THEN
         IF (NORM2(DV%OVEC)>TWO_EPSILON_EB) THEN
            SOLID_PHASE_OUTPUT = DOT_PRODUCT(FVEC,DV%OVEC)
            ! print *,'FO: ', SOLID_PHASE_OUTPUT
            ! print *
         ENDIF
      ENDIF

   CASE(67) ! WALL PRESSURE TEST (takes optional IOR or ORIENTATION vector)
      IF (PRESENT(OPT_WALL_INDEX)) THEN
         SELECT CASE(ONE_D%IOR)
            CASE( 1); NVEC=(/ 1._EB,0._EB,0._EB/)
            CASE(-1); NVEC=(/-1._EB,0._EB,0._EB/)
            CASE( 2); NVEC=(/0._EB, 1._EB,0._EB/)
            CASE(-2); NVEC=(/0._EB,-1._EB,0._EB/)
            CASE( 3); NVEC=(/0._EB,0._EB, 1._EB/)
            CASE(-3); NVEC=(/0._EB,0._EB,-1._EB/)
         END SELECT
         IIG = ONE_D%IIG
         JJG = ONE_D%JJG
         KKG = ONE_D%KKG
         PVEC = ONE_D%RHO_G*H(IIG,JJG,KKG) * NVEC ! surface normal pressure force
      ELSEIF (PRESENT(OPT_CFACE_INDEX)) THEN
         NVEC = CFA%NVEC
         ! find cut-cell adjacent to CFACE
         IND1 = CFA%CUT_FACE_IND1
         IND2 = CFA%CUT_FACE_IND2
         CALL GET_PRES_CFACE_TEST(PRESS,IND1,IND2,ONE_D)
         PVEC = PRESS * NVEC ! surface normal pressure force
      ENDIF

      SOLID_PHASE_OUTPUT = DOT_PRODUCT(PVEC,NVEC)

      IF(FROM_BNDF) RETURN

      IF (ASSOCIATED(DV)) THEN
         IF (NORM2(DV%OVEC)>TWO_EPSILON_EB) THEN
            SOLID_PHASE_OUTPUT = -DOT_PRODUCT(PVEC,DV%OVEC)
         ENDIF
      ENDIF

END SELECT SOLID_PHASE_SELECT

END FUNCTION SOLID_PHASE_OUTPUT


REAL(EB) FUNCTION HVAC_OUTPUT(IND,Y_INDEX,Z_INDEX,DUCT_INDEX,NODE_INDEX,DUCT_CELL_INDEX)

! Compute HVAC Output Quantities

USE MATH_FUNCTIONS, ONLY: INTERPOLATE1D,EVALUATE_RAMP
USE PHYSICAL_FUNCTIONS, ONLY: GET_MASS_FRACTION,GET_MOLECULAR_WEIGHT
INTEGER, INTENT(IN) :: Y_INDEX,Z_INDEX,IND,DUCT_INDEX,NODE_INDEX(2),DUCT_CELL_INDEX
REAL(EB) :: Y_H2O,ZZ_GET(1:N_TRACKED_SPECIES),MW,Y_SPECIES,RCON

Y_H2O = 0._EB
Y_SPECIES=1.0_EB
! Get species mass fraction if necessary
IF (DUCT_INDEX > 0 .AND. DUCT_CELL_INDEX < 1) THEN ! Duct values required
   IF (Z_INDEX > 0) THEN
      Y_SPECIES = DUCT(DUCT_INDEX)%ZZ(Z_INDEX)
      RCON = SPECIES_MIXTURE(Z_INDEX)%RCON
   ELSEIF (Y_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ(1:N_TRACKED_SPECIES)
      RCON = SPECIES(Y_INDEX)%RCON
      CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
   ENDIF
   IF (DRY .AND. H2O_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ(1:N_TRACKED_SPECIES)
      CALL GET_MASS_FRACTION(ZZ_GET,H2O_INDEX,Y_H2O)
      IF (Y_INDEX==H2O_INDEX) Y_SPECIES=0._EB
   ENDIF
ENDIF

IF (DUCT_INDEX > 0 .AND. DUCT_CELL_INDEX > 0) THEN ! Duct cell values required
   IF (Z_INDEX > 0) THEN
      Y_SPECIES = DUCT(DUCT_INDEX)%ZZ_C(DUCT_CELL_INDEX,Z_INDEX)
      RCON = SPECIES_MIXTURE(Z_INDEX)%RCON
   ELSEIF (Y_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ_C(DUCT_CELL_INDEX,1:N_TRACKED_SPECIES)
      RCON = SPECIES(Y_INDEX)%RCON
      CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
   ENDIF
   IF (DRY .AND. H2O_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ_C(DUCT_CELL_INDEX,1:N_TRACKED_SPECIES)
      CALL GET_MASS_FRACTION(ZZ_GET,H2O_INDEX,Y_H2O)
      IF (Y_INDEX==H2O_INDEX) Y_SPECIES=0._EB
   ENDIF
ENDIF

IF (NODE_INDEX(1) > 0) THEN
   IF (Z_INDEX > 0) THEN
      Y_SPECIES = DUCTNODE(NODE_INDEX(1))%ZZ(Z_INDEX)
      RCON = SPECIES_MIXTURE(Z_INDEX)%RCON
   ELSEIF (Y_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCTNODE(NODE_INDEX(1))%ZZ(1:N_TRACKED_SPECIES)
      RCON = SPECIES(Y_INDEX)%RCON
      CALL GET_MASS_FRACTION(ZZ_GET,Y_INDEX,Y_SPECIES)
   ENDIF
   IF (DRY .AND. H2O_INDEX > 0) THEN
      ZZ_GET(1:N_TRACKED_SPECIES) = DUCTNODE(NODE_INDEX(1))%ZZ(1:N_TRACKED_SPECIES)
      CALL GET_MASS_FRACTION(ZZ_GET,H2O_INDEX,Y_H2O)
      IF (Y_INDEX==H2O_INDEX) Y_SPECIES=0._EB
   ENDIF
ENDIF

SELECT CASE(IND)
   CASE DEFAULT
      HVAC_OUTPUT = 0._EB
   CASE(300)  ! Duct Velocity
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%VEL(OLD)
   CASE(301)  ! Duct Temperature
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%TMP_D - TMPM
   CASE(302)  ! Duct Mass Flow
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%VEL(OLD)*DUCT(DUCT_INDEX)%RHO_D*DUCT(DUCT_INDEX)%AREA*Y_SPECIES/(1._EB-Y_H2O)
   CASE(303)  ! Duct Volume Flow
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%VEL(OLD)*DUCT(DUCT_INDEX)%AREA
   CASE(304:305) ! Species
      IF (IND==304) THEN ! Mass Fraction
         HVAC_OUTPUT = Y_SPECIES/(1._EB-Y_H2O)
      ELSE ! Volume Fraction
         ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ(1:N_TRACKED_SPECIES)
         CALL GET_MOLECULAR_WEIGHT(ZZ_GET,MW)
         HVAC_OUTPUT = RCON/R0*MW*Y_SPECIES/(1._EB-Y_H2O*MW/MW_H2O)
      ENDIF
   CASE(306)  ! Duct Density
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%RHO_D
   CASE(307)  ! Duct cell temperature
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%TMP_C(DUCT_CELL_INDEX) - TMPM
   CASE(308) ! Duct cell density
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%RHO_C(DUCT_CELL_INDEX)
   CASE(309:310) ! Species
      IF (IND==309) THEN ! Mass Fraction
         HVAC_OUTPUT = Y_SPECIES/(1._EB-Y_H2O)
      ELSE ! Volume Fraction
         ZZ_GET(1:N_TRACKED_SPECIES) = DUCT(DUCT_INDEX)%ZZ_C(DUCT_CELL_INDEX,1:N_TRACKED_SPECIES)
         CALL GET_MOLECULAR_WEIGHT(ZZ_GET,MW)
         HVAC_OUTPUT = RCON/R0*MW*Y_SPECIES/(1._EB-Y_H2O*MW/MW_H2O)
      ENDIF
   CASE(330) ! Node Pressure
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(1))%P
   CASE(331) ! Node Density
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(1))%RHO
   CASE(332) ! Node Temperature
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(1))%TMP - TMPM
   CASE(333:334)! Species
      IF (IND==333) THEN ! Mass Fraction
         HVAC_OUTPUT = Y_SPECIES/(1._EB-Y_H2O)
      ELSE ! Volume Fraction
         ZZ_GET(1:N_TRACKED_SPECIES) = DUCTNODE(NODE_INDEX(1))%ZZ(1:N_TRACKED_SPECIES)
         CALL GET_MOLECULAR_WEIGHT(ZZ_GET,MW)
         HVAC_OUTPUT = RCON/R0*MW*Y_SPECIES/(1._EB-Y_H2O*MW/MW_H2O)
      ENDIF
   CASE(335) ! Node Pressure Difference
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(2))%P - DUCTNODE(NODE_INDEX(1))%P
   CASE(336) ! Filter loading
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(1))%FILTER_LOADING(Z_INDEX,1)
   CASE(337) ! Aircoil Heat Removal
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%COIL_Q * 0.001_EB
   CASE(338) ! Filter flow loss
      HVAC_OUTPUT = DUCTNODE(NODE_INDEX(1))%FILTER_LOSS
   CASE(339) ! Fan Pressure
      HVAC_OUTPUT = DUCT(DUCT_INDEX)%DP_FAN(1)
END SELECT

END FUNCTION HVAC_OUTPUT


REAL(EB) FUNCTION PARTICLE_OUTPUT(T,IND,LP_INDEX)

! Assign particle output quantities to devices

INTEGER, INTENT(IN) :: IND,LP_INDEX
REAL(EB), INTENT(IN) :: T

LP => LAGRANGIAN_PARTICLE(LP_INDEX)

         SELECT CASE(IND)
            CASE(434)  ! PARTICLE DIAMETER
               PARTICLE_OUTPUT = 2.E6*SUM(LP%ONE_D%LAYER_THICKNESS)
            CASE(435)  ! PARTICLE VELOCITY
               PARTICLE_OUTPUT = SQRT(LP%U**2+LP%V**2+LP%W**2)
            CASE(436)  ! PARTICLE PHASE
               PARTICLE_OUTPUT = LP%ONE_D%IOR
            CASE(437)  ! PARTICLE TEMPERATURE
               PARTICLE_OUTPUT = LP%ONE_D%TMP_F - TMPM
            CASE(438)  ! PARTICLE MASS
               PARTICLE_OUTPUT = LP%MASS
            CASE(439)  ! PARTICLE AGE
               PARTICLE_OUTPUT = T-LP%T_INSERT
            CASE(440)  ! PARTICLE WEIGHTING FACTOR
               PARTICLE_OUTPUT = LP%PWT
            CASE(441)  ! PARTICLE X
               PARTICLE_OUTPUT = LP%X
            CASE(442)  ! PARTICLE Y
               PARTICLE_OUTPUT = LP%Y
            CASE(443)  ! PARTICLE Z
               PARTICLE_OUTPUT = LP%Z
            CASE(444)  ! PARTICLE U
               PARTICLE_OUTPUT = LP%U
            CASE(445)  ! PARTICLE V
               PARTICLE_OUTPUT = LP%V
            CASE(446)  ! PARTICLE W
               PARTICLE_OUTPUT = LP%W
         END SELECT

END FUNCTION PARTICLE_OUTPUT


REAL(EB) FUNCTION TENSOR_OUTPUT(II,JJ,KK,IND,IOR,NM)

! Compute local total stress tensor and dot with unit normal

INTEGER, INTENT(IN) :: II,JJ,KK,IND,IOR,NM
REAL(EB) :: U_I,U_J,RHOP,MUA,HP,KP,S_IJ,DIV,TAU_IJ,DUDY,DUDZ,DVDX,DVDZ,DWDX,DWDY

TENSOR_OUTPUT = 0._EB

CALL POINT_TO_MESH(NM)

COMPONENT_SELECT: SELECT CASE(IND)
   CASE(1)
      NORMAL_SELECT_1: SELECT CASE(IOR)
         CASE(+1)
            U_I  = U(II,JJ,KK)
            U_J  = U(II,JJ,KK)
            RHOP = 0.5_EB*( RHO(II,JJ,KK)+ RHO(II+1,JJ,KK))
            MUA  = 0.5_EB*(  MU(II,JJ,KK)+  MU(II+1,JJ,KK))
            HP   = 0.5_EB*(  HS(II,JJ,KK)+  HS(II+1,JJ,KK))
            KP   = 0.5_EB*(KRES(II,JJ,KK)+KRES(II+1,JJ,KK))
            DIV  = 0.5_EB*(  DS(II,JJ,KK)+  DS(II+1,JJ,KK))
            S_IJ = 0.5_EB*(RDX(II+1)*(U(II+1,JJ,KK)-U(II,JJ,KK)) + RDX(II)*(U(II,JJ,KK)-U(II-1,JJ,KK)))
         CASE(-1)
            U_I  = U(II-1,JJ,KK)
            U_J  = U(II-1,JJ,KK)
            RHOP = 0.5_EB*( RHO(II-1,JJ,KK)+ RHO(II,JJ,KK))
            MUA  = 0.5_EB*(  MU(II-1,JJ,KK)+  MU(II,JJ,KK))
            HP   = 0.5_EB*(  HS(II-1,JJ,KK)+  HS(II,JJ,KK))
            KP   = 0.5_EB*(KRES(II-1,JJ,KK)+KRES(II,JJ,KK))
            DIV  = 0.5_EB*(  DS(II-1,JJ,KK)+  DS(II,JJ,KK))
            S_IJ = 0.5_EB*(RDX(II)*(U(II,JJ,KK)-U(II-1,JJ,KK)) + RDX(II-1)*(U(II-1,JJ,KK)-U(II-2,JJ,KK)))
         CASE(+2)
            U_I  = 0.25_EB*(U(II,JJ,KK)+U(II-1,JJ,KK)+U(II-1,JJ+1,KK)+U(II,JJ+1,KK))
            U_J  = V(II,JJ,KK)
            RHOP = 0.5_EB*( RHO(II,JJ,KK)+ RHO(II,JJ+1,KK))
            MUA  = 0.5_EB*(  MU(II,JJ,KK)+  MU(II,JJ+1,KK))
            HP   = 0._EB
            KP   = 0._EB
            DIV  = 0._EB
            DUDY = 0.5_EB*(RDYN(JJ)*(U(II,JJ+1,KK)-U(II,JJ,KK)) + RDYN(JJ)*(U(II-1,JJ+1,KK)-U(II-1,JJ,KK)))
            DVDX = 0.5_EB*(RDXN(II)*(V(II+1,JJ,KK)-V(II,JJ,KK)) + RDXN(II-1)*(V(II,JJ,KK)-V(II-1,JJ,KK)))
            S_IJ = 0.5_EB*(DUDY+DVDX)
         CASE(-2)
            U_I  = 0.25_EB*(U(II,JJ,KK)+U(II,JJ-1,KK)+U(II-1,JJ-1,KK)+U(II-1,JJ,KK))
            U_J  = V(II,JJ-1,KK)
            RHOP = 0.5_EB*( RHO(II,JJ-1,KK)+ RHO(II,JJ,KK))
            MUA  = 0.5_EB*(  MU(II,JJ-1,KK)+  MU(II,JJ,KK))
            HP   = 0._EB
            KP   = 0._EB
            DIV  = 0._EB
            DUDY = 0.5_EB*(RDYN(JJ-1)*(U(II,JJ,KK)-U(II,JJ-1,KK)) + RDYN(JJ-1)*(U(II-1,JJ,KK)-U(II-1,JJ-1,KK)))
            DVDX = 0.5_EB*(RDXN(II)*(V(II+1,JJ-1,KK)-V(II,JJ-1,KK)) + RDXN(II-1)*(V(II,JJ-1,KK)-V(II-1,JJ-1,KK)))
            S_IJ = 0.5_EB*(DUDY+DVDX)
         CASE(+3)
            U_I  = 0.25_EB*(U(II,JJ,KK)+U(II-1,JJ,KK)+U(II-1,JJ,KK+1)+U(II,JJ,KK+1))
            U_J  = W(II,JJ,KK)
            RHOP = 0.5_EB*( RHO(II,JJ,KK)+ RHO(II,JJ,KK+1))
            MUA  = 0.5_EB*(  MU(II,JJ,KK)+  MU(II,JJ,KK+1))
            HP   = 0._EB
            KP   = 0._EB
            DIV  = 0._EB
            DUDZ = 0.5_EB*(RDZN(KK)*(U(II,JJ,KK+1)-U(II,JJ,KK)) + RDZN(KK)*(U(II-1,JJ,KK+1)-U(II-1,JJ,KK)))
            DWDX = 0.5_EB*(RDXN(II)*(W(II+1,JJ,KK)-W(II,JJ,KK)) + RDXN(II-1)*(W(II,JJ,KK)-W(II-1,JJ,KK)))
            S_IJ = 0.5_EB*(DUDZ+DWDX)
         CASE(-3)
            U_I  = 0.25_EB*(U(II,JJ,KK)+U(II,JJ,KK-1)+U(II-1,JJ,KK-1)+U(II-1,JJ,KK))
            U_J  = W(II,JJ,KK-1)
            RHOP = 0.5_EB*( RHO(II,JJ,KK-1)+ RHO(II,JJ,KK))
            MUA  = 0.5_EB*(  MU(II,JJ,KK-1)+  MU(II,JJ,KK))
            HP   = 0._EB
            KP   = 0._EB
            DIV  = 0._EB
            DUDZ = 0.5_EB*(RDZN(KK-1)*(U(II,JJ,KK)-U(II,JJ,KK-1)) + RDZN(KK-1)*(U(II-1,JJ,KK)-U(II-1,JJ,KK-1)))
            DWDX = 0.5_EB*(RDXN(II)*(W(II+1,JJ,KK-1)-W(II,JJ,KK-1)) + RDXN(II-1)*(W(II,JJ,KK-1)-W(II-1,JJ,KK-1)))
            S_IJ = 0.5_EB*(DUDZ+DWDX)
      END SELECT NORMAL_SELECT_1
   CASE(2)
      ! need for 3D
   CASE(3)
      NORMAL_SELECT_3: SELECT CASE(IOR)
         CASE(+1)
            U_I  = 0.25_EB*(W(II,JJ,KK)+W(II+1,JJ,KK)+W(II+1,JJ,KK-1)+W(II,JJ,KK-1))
            U_J  = U(II,JJ,KK)
            RHOP = 0.5_EB*( RHO(II,JJ,KK)+ RHO(II+1,JJ,KK))
            MUA  = 0.5_EB*(  MU(II,JJ,KK)+  MU(II+1,JJ,KK))
            HP   = 0._EB
            KP   = 0._EB
            DIV  = 0._EB
            DWDX = 0.5_EB*(RDXN(II)*(W(II+1,JJ,KK)-W(II,JJ,KK)) + RDXN(II)*(W(II+1,JJ,KK-1)-W(II,JJ,KK-1)))
            DUDZ = 0.5_EB*(RDZN(KK)*(U(II,JJ,KK+1)-U(II,JJ,KK)) + RDZN(KK-1)*(U(II,JJ,KK)-U(II,JJ,KK-1)))
            S_IJ = 0.5_EB*(DWDX+DUDZ)
         CASE(-1)
            U_I  = 0.25_EB*(W(II-1,JJ,KK)+W(II,JJ,KK)+W(II,JJ,KK-1)+W(II-1,JJ,KK-1))
            U_J  = U(II-1,JJ,KK)
            RHOP = 0.5_EB*( RHO(II-1,JJ,KK)+ RHO(II,JJ,KK))
            MUA  = 0.5_EB*(  MU(II-1,JJ,KK)+  MU(II,JJ,KK))
            HP   = 0._EB
            KP   = 0._EB
            DIV  = 0._EB
            DWDX = 0.5_EB*(RDXN(II-1)*(W(II,JJ,KK)-W(II-1,JJ,KK)) + RDXN(II-1)*(W(II,JJ,KK-1)-W(II-1,JJ,KK-1)))
            DUDZ = 0.5_EB*(RDZN(KK)*(U(II-1,JJ,KK+1)-U(II-1,JJ,KK)) + RDZN(KK-1)*(U(II-1,JJ,KK)-U(II-1,JJ,KK-1)))
            S_IJ = 0.5_EB*(DWDX+DUDZ)
         CASE(+2)
            U_I  = 0.25_EB*(W(II,JJ,KK)+W(II,JJ+1,KK)+W(II,JJ+1,KK-1)+W(II,JJ,KK-1))
            U_J  = V(II,JJ,KK)
            RHOP = 0.5_EB*( RHO(II,JJ,KK)+ RHO(II,JJ+1,KK))
            MUA  = 0.5_EB*(  MU(II,JJ,KK)+  MU(II,JJ+1,KK))
            HP   = 0._EB
            KP   = 0._EB
            DIV  = 0._EB
            DWDY = 0.5_EB*(RDYN(JJ)*(W(II,JJ+1,KK)-W(II,JJ,KK)) + RDYN(JJ)*(W(II,JJ+1,KK-1)-W(II,JJ,KK-1)))
            DVDZ = 0.5_EB*(RDZN(KK)*(V(II,JJ,KK+1)-V(II,JJ,KK)) + RDZN(KK-1)*(V(II,JJ,KK)-V(II,JJ,KK-1)))
            S_IJ = 0.5_EB*(DWDY+DVDZ)
         CASE(-2)
            U_I  = 0.25_EB*(W(II,JJ,KK)+W(II,JJ-1,KK)+W(II-1,JJ-1,KK)+W(II-1,JJ,KK))
            U_J  = V(II,JJ-1,KK)
            RHOP = 0.5_EB*( RHO(II,JJ-1,KK)+ RHO(II,JJ,KK))
            MUA  = 0.5_EB*(  MU(II,JJ-1,KK)+  MU(II,JJ,KK))
            HP   = 0._EB
            KP   = 0._EB
            DIV  = 0._EB
            DWDY = 0.5_EB*(RDYN(JJ-1)*(W(II,JJ,KK)-W(II,JJ-1,KK)) + RDYN(JJ-1)*(W(II,JJ,KK-1)-W(II,JJ-1,KK-1)))
            DVDZ = 0.5_EB*(RDZN(KK)*(V(II,JJ-1,KK+1)-V(II,JJ-1,KK)) + RDZN(KK-1)*(V(II,JJ-1,KK)-V(II,JJ-1,KK-1)))
            S_IJ = 0.5_EB*(DWDY+DVDZ)
         CASE(+3)
            U_I  = W(II,JJ,KK)
            U_J  = W(II,JJ,KK)
            RHOP = 0.5_EB*( RHO(II,JJ,KK)+ RHO(II,JJ,KK+1))
            MUA  = 0.5_EB*(  MU(II,JJ,KK)+  MU(II,JJ,KK+1))
            HP   = 0.5_EB*(  HS(II,JJ,KK)+  HS(II,JJ,KK+1))
            KP   = 0.5_EB*(KRES(II,JJ,KK)+KRES(II,JJ,KK+1))
            DIV  = 0.5_EB*(  DS(II,JJ,KK)+  DS(II,JJ,KK+1))
            S_IJ = 0.5_EB*(RDZ(KK+1)*(W(II,JJ,KK+1)-W(II,JJ,KK)) + RDZ(KK)*(W(II,JJ,KK)-W(II,JJ,KK-1)))
         CASE(-3)
            U_I  = W(II,JJ,KK-1)
            U_J  = W(II,JJ,KK-1)
            RHOP = 0.5_EB*( RHO(II,JJ,KK-1)+ RHO(II,JJ,KK))
            MUA  = 0.5_EB*(  MU(II,JJ,KK-1)+  MU(II,JJ,KK))
            HP   = 0.5_EB*(  HS(II,JJ,KK-1)+  HS(II,JJ,KK))
            KP   = 0.5_EB*(KRES(II,JJ,KK-1)+KRES(II,JJ,KK))
            DIV  = 0.5_EB*(  DS(II,JJ,KK-1)+  DS(II,JJ,KK))
            S_IJ = 0.5_EB*(RDZ(KK)*(W(II,JJ,KK)-W(II,JJ,KK-1)) + RDZ(KK-1)*(W(II,JJ,KK-1)-W(II,JJ,KK-2)))
      END SELECT NORMAL_SELECT_3
END SELECT COMPONENT_SELECT

TAU_IJ = -2._EB*MUA*(S_IJ - ONTH*DIV)
TENSOR_OUTPUT = RHOP*U_I*U_J + RHOP*(HP-KP) + TAU_IJ

END FUNCTION TENSOR_OUTPUT


SUBROUTINE DUMP_DEVICES(T)

! Write out to CHID_devc.csv the DEViCe output quantities every DT_DEVC s

REAL(EB), INTENT(IN) :: T
REAL(EB) :: STIME,DI,DD,VALUE
INTEGER :: I,J,N,NN,N_OUT
REAL(EB) :: DEVC_TIME,CONST,CUMSUM,COORD_FACTOR

! Determine the time to write into file

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR
DEVC_TIME = STIME

! Load time and line device values into arrays

IF (LU_LINE > 0) THEN
   INQUIRE(LU_LINE,OPENED=OPN)
   IF (OPN) CLOSE(LU_LINE)
ENDIF


IF (N_PDPA_HISTOGRAM>0) THEN

   N=0
   DO J=1,N_PDPA_HISTOGRAM
      DV => DEVICE(J)
      PY => PROPERTY(DV%PROP_INDEX)
      IF (PY%PDPA_HISTOGRAM) THEN
         N=N+1
         PDPA_HISTOGRAM_VALUE(N,:) = 'NaN,NaN'
      ENDIF
   ENDDO

   N=0
   DO J=1,N_DEVC
      DV => DEVICE(J)
      PY => PROPERTY(DV%PROP_INDEX)
      IF (PY%PDPA_HISTOGRAM) THEN
         N=N+1
         !
         ! Scale the bin center coordinates
         SELECT CASE(PY%QUANTITY)
            CASE('DIAMETER') ! m -> mu-m
               COORD_FACTOR=1E6_EB
            CASE DEFAULT
               COORD_FACTOR=1._EB
         END SELECT
         DD=(PY%PDPA_HISTOGRAM_LIMITS(2)-PY%PDPA_HISTOGRAM_LIMITS(1))/PY%PDPA_HISTOGRAM_NBINS
         CONST = SUM(DV%PDPA_HISTOGRAM_COUNTS(1:PY%PDPA_HISTOGRAM_NBINS))
         CUMSUM = 0._EB
         DO NN =1,MAX_PDPA_HISTOGRAM_NBINS
            IF(NN>PY%PDPA_HISTOGRAM_NBINS) EXIT
            VALUE = DV%PDPA_HISTOGRAM_COUNTS(NN)
            CUMSUM = CUMSUM + VALUE
            DI=PY%PDPA_HISTOGRAM_LIMITS(1)+(REAL(NN,EB)-0.5_EB)*DD
            IF(PY%PDPA_HISTOGRAM_CUMULATIVE) VALUE = CUMSUM
            IF(PY%PDPA_NORMALIZE .AND. CONST>TWO_EPSILON_EB) VALUE = VALUE / CONST
            WRITE(TCFORM,'(5A)') "(1(",FMT_R,",A),",FMT_R,")"
            WRITE(PDPA_HISTOGRAM_VALUE(N,NN),TCFORM) DI*COORD_FACTOR,',',VALUE
         ENDDO
      ENDIF
   ENDDO

   INQUIRE(LU_HISTOGRAM,OPENED=OPN)
   IF (OPN) CLOSE(LU_HISTOGRAM)
   OPEN(LU_HISTOGRAM,FILE=FN_HISTOGRAM,FORM='FORMATTED',STATUS='REPLACE')
   IF (N_PDPA_HISTOGRAM==1) WRITE(TCFORM,'(A)') "(A)"
   IF (N_PDPA_HISTOGRAM>1 ) WRITE(TCFORM,'(A,I4.4,A)') "(",N_PDPA_HISTOGRAM-1,"(A,','),A)"
   WRITE(LU_HISTOGRAM,TCFORM) (TRIM(PDPA_HISTOGRAM_UNITS(N)),N=1,N_PDPA_HISTOGRAM)
   WRITE(LU_HISTOGRAM,TCFORM) (TRIM(PDPA_HISTOGRAM_LABEL(N)),N=1,N_PDPA_HISTOGRAM)
   DO N=1,MAX_PDPA_HISTOGRAM_NBINS
      WRITE(LU_HISTOGRAM,TCFORM) (TRIM(PDPA_HISTOGRAM_VALUE(NN,N)),NN=1,N_PDPA_HISTOGRAM)
   ENDDO
   CLOSE(LU_HISTOGRAM)
ENDIF

! Compute the time-averaged point device values

NN = 0
DO N=1,N_DEVC
   DV => DEVICE(N)
   IF (DV%LINE==0 .AND. DV%OUTPUT) THEN
      NN = NN + 1
      TIME_DEVC_VALUE(NN) = DV%VALUE/DV%TIME_INTERVAL
   ENDIF
ENDDO

! Write the point device values into CHID_devc.csv

DO I=1,N_DEVC_FILES
   N_OUT = MIN(DEVC_COLUMN_LIMIT, N_DEVC_TIME - DEVC_COLUMN_LIMIT * (I - 1))
   WRITE(TCFORM,'(A,I5.5,5A)') "(",N_OUT,"(",FMT_R,",','),",FMT_R,")"
   WRITE(LU_DEVC(I),TCFORM) DEVC_TIME,(TIME_DEVC_VALUE(N),N=DEVC_COLUMN_LIMIT*(I-1)+1, MIN(N_DEVC_TIME,DEVC_COLUMN_LIMIT*I))
ENDDO

! Write the line device values into CHID_line.csv

IF (N_DEVC_LINE>0) THEN

   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE>0 .AND. DV%POINT==1) THEN
         SELECT CASE(DV%LINE_COORD_CODE)
            CASE(0)
               LINE_DEVC_VALUE(DV%LINE,:) = 'NaN'
            CASE(1:5)
               LINE_DEVC_VALUE(DV%LINE,:) = 'NaN,NaN'
            CASE(12:23)
               LINE_DEVC_VALUE(DV%LINE,:) = 'NaN,NaN,NaN'
            CASE(123)
               LINE_DEVC_VALUE(DV%LINE,:) = 'NaN,NaN,NaN,NaN'
         END SELECT
      ENDIF
   ENDDO

   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%LINE>0) THEN
         SELECT CASE(DV%LINE_COORD_CODE)
            CASE(0)
               WRITE(TCFORM,'(3A)') "(",FMT_R,")"
               WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) DV%VALUE/DV%TIME_INTERVAL
            CASE(1)
               WRITE(TCFORM,'(5A)') "(1(",FMT_R,",A),",FMT_R,")"
               WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) DV%X*DV%COORD_FACTOR,',',DV%VALUE/DV%TIME_INTERVAL
            CASE(2)
               WRITE(TCFORM,'(5A)') "(1(",FMT_R,",A),",FMT_R,")"
               WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) DV%Y*DV%COORD_FACTOR,',',DV%VALUE/DV%TIME_INTERVAL
            CASE(3)
               WRITE(TCFORM,'(5A)') "(1(",FMT_R,",A),",FMT_R,")"
               WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) DV%Z*DV%COORD_FACTOR,',',DV%VALUE/DV%TIME_INTERVAL
            CASE(4)
               WRITE(TCFORM,'(5A)') "(1(",FMT_R,",A),",FMT_R,")"
               WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) SQRT(DV%X**2+DV%Y**2+DV%Z**2)*DV%COORD_FACTOR, &
                                                               ',',DV%VALUE/DV%TIME_INTERVAL
            CASE(5)
               WRITE(TCFORM,'(5A)') "(1(",FMT_R,",A),",FMT_R,")"
               WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) SQRT((DV%X-DV%X1)**2+(DV%Y-DV%Y1)**2+(DV%Z-DV%Z1)**2)&
                                              *DV%COORD_FACTOR,',',DV%VALUE/DV%TIME_INTERVAL
            CASE(12)
               WRITE(TCFORM,'(5A)') "(2(",FMT_R,",A),",FMT_R,")"
               WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) &
                  DV%X*DV%COORD_FACTOR,',',DV%Y*DV%COORD_FACTOR,',',DV%VALUE/DV%TIME_INTERVAL
            CASE(13)
               WRITE(TCFORM,'(5A)') "(2(",FMT_R,",A),",FMT_R,")"
               WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) &
                  DV%X*DV%COORD_FACTOR,',',DV%Z*DV%COORD_FACTOR,',',DV%VALUE/DV%TIME_INTERVAL
            CASE(23)
               WRITE(TCFORM,'(5A)') "(2(",FMT_R,",A),",FMT_R,")"
               WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) &
                  DV%Y*DV%COORD_FACTOR,',',DV%Z*DV%COORD_FACTOR,',',DV%VALUE/DV%TIME_INTERVAL
            CASE(123)
               WRITE(TCFORM,'(5A)') "(3(",FMT_R,",A),",FMT_R,")"
               WRITE(LINE_DEVC_VALUE(DV%LINE,DV%POINT),TCFORM) &
                  DV%X*DV%COORD_FACTOR,',',DV%Y*DV%COORD_FACTOR,',',DV%Z*DV%COORD_FACTOR,',',DV%VALUE/DV%TIME_INTERVAL
         END SELECT
      ENDIF
   ENDDO

   INQUIRE(LU_LINE,OPENED=OPN)
   IF (OPN) CLOSE(LU_LINE)
   OPEN(LU_LINE,FILE=FN_LINE,FORM='FORMATTED',STATUS='REPLACE')
   IF (N_DEVC_LINE==1) WRITE(TCFORM,'(A)') "(A)"
   IF (N_DEVC_LINE>1 ) WRITE(TCFORM,'(A,I4.4,A)') "(",N_DEVC_LINE-1,"(A,','),A)"
   WRITE(LU_LINE,TCFORM) (TRIM(LINE_DEVC_UNITS(N)),N=1,N_DEVC_LINE)
   WRITE(LU_LINE,TCFORM) (TRIM(LINE_DEVC_LABEL(N)),N=1,N_DEVC_LINE)
   DO N=1,MAX_DEVC_LINE_POINTS
      WRITE(LU_LINE,TCFORM) (TRIM(LINE_DEVC_VALUE(NN,N)),NN=1,N_DEVC_LINE)
   ENDDO
   CLOSE(LU_LINE)
ENDIF

END SUBROUTINE DUMP_DEVICES


SUBROUTINE DUMP_CONTROLS(T)

! Write out to CHID_ctrl.csv the ConTRoL output quantities every DT_CTRL s

USE CONTROL_VARIABLES
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER :: WRITE_VALUE(N_CTRL)
INTEGER :: I,N,N_OUT

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
WHERE (CONTROL%CURRENT_STATE)
   WRITE_VALUE=1
ELSEWHERE
   WRITE_VALUE=-1
END WHERE

DO I=1,N_CTRL_FILES
   N_OUT = MIN(CTRL_COLUMN_LIMIT, N_CTRL - CTRL_COLUMN_LIMIT * (I - 1))
   WRITE(TCFORM,'(3A,I5.5,A)') "(",FMT_R,",",N_OUT,"(',',I2))"
   WRITE(LU_CTRL(I),TCFORM) STIME,(WRITE_VALUE(N), N=CTRL_COLUMN_LIMIT*(I-1)+1, MIN(N_CTRL,CTRL_COLUMN_LIMIT*I))
ENDDO

END SUBROUTINE DUMP_CONTROLS


SUBROUTINE DUMP_PROF(T,NM)

! Write out to CHID_prof_nn.csv the PROFile data every DT_PROF s

USE GEOMETRY_FUNCTIONS, ONLY: GET_WALL_NODE_WEIGHTS
USE MEMORY_FUNCTIONS, ONLY: GET_LAGRANGIAN_PARTICLE_INDEX
REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER, INTENT(IN)  :: NM
INTEGER :: I,N,NN,IW,SURF_INDEX,NWP,LP_INDEX
REAL(EB) :: DXF,DXB,THICKNESS
TYPE (PROFILE_TYPE), POINTER :: PF
TYPE(ONE_D_M_AND_E_XFER_TYPE), POINTER :: ONE_D

IF (EVACUATION_ONLY(NM)) RETURN

PROF_LOOP: DO N=1,N_PROF

   PF => PROFILE(N)
   IF (NM/=PF%MESH) CYCLE PROF_LOOP

   IF (PF%WALL_INDEX>0) THEN
      IW  =  PF%WALL_INDEX
      WC  => MESHES(NM)%WALL(IW)
      IF (WC%BOUNDARY_TYPE==NULL_BOUNDARY) CYCLE PROF_LOOP
      ONE_D => WC%ONE_D
      SURF_INDEX = WC%SURF_INDEX
   ELSEIF (PF%LP_TAG>0) THEN
      CALL GET_LAGRANGIAN_PARTICLE_INDEX(NM,PF%PART_CLASS_INDEX,PF%LP_TAG,LP_INDEX)
      IF (LP_INDEX==0) CYCLE PROF_LOOP
      ONE_D => MESHES(NM)%LAGRANGIAN_PARTICLE(LP_INDEX)%ONE_D
      SURF_INDEX = LAGRANGIAN_PARTICLE_CLASS(PF%PART_CLASS_INDEX)%SURF_INDEX
   ELSE
      CYCLE PROF_LOOP
   ENDIF

   SF  => SURFACE(SURF_INDEX)
   IF (SF%PYROLYSIS_MODEL==PYROLYSIS_PREDICTED) THEN
      NWP = SUM(ONE_D%N_LAYER_CELLS)
      IF (NWP==0) CYCLE PROF_LOOP
      X_S_NEW(0:NWP) = ONE_D%X(0:NWP)
      THICKNESS = SUM(ONE_D%LAYER_THICKNESS)
      CALL GET_WALL_NODE_WEIGHTS(NWP,SF%N_LAYERS,ONE_D%N_LAYER_CELLS,ONE_D%LAYER_THICKNESS,SF%GEOMETRY, &
         ONE_D%X(0:NWP),SF%LAYER_DIVIDE,DX_S(1:NWP),RDX_S(0:NWP+1),RDXN_S(0:NWP),DX_WGT_S(0:NWP),DXF,DXB,LAYER_INDEX,MF_FRAC,&
         SF%INNER_RADIUS)
   ELSE
      NWP = SF%N_CELLS_INI
      IF (NWP==0) CYCLE PROF_LOOP
      X_S_NEW(0:NWP) = SF%X_S(0:NWP)
      DX_WGT_S(0:NWP) = SF%DX_WGT(0:NWP)
   ENDIF

   STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
   WRITE(TCFORM,'(3A,I5,5A)') "(",FMT_R,",',',I5,',',",2*NWP+1,"(",FMT_R,",','),",FMT_R,")"
   IF (PF%QUANTITY == 'TEMPERATURE') THEN
      IF (PF%FORMAT_INDEX==1) THEN
         WRITE(LU_PROF(N),TCFORM) STIME,NWP+1,(X_S_NEW(I),I=0,NWP),&
                                 (ONE_D%TMP(I)+DX_WGT_S(I)*(ONE_D%TMP(I+1)-ONE_D%TMP(I))-TMPM,I=0,NWP)
      ELSE
         REWIND(LU_PROF(N))
         WRITE(LU_PROF(N),'(A)') 'm,C'
         WRITE(LU_PROF(N),'(A)') 'Depth,Temperature'
         WRITE(TCFORM,'(5A)') "(" , FMT_R , ",','," , FMT_R , ")"
         DO I=0,NWP
            WRITE(LU_PROF(N),TCFORM) X_S_NEW(I),ONE_D%TMP(I)+DX_WGT_S(I)*(ONE_D%TMP(I+1)-ONE_D%TMP(I))-TMPM
         ENDDO
      ENDIF
   ELSE
      RHO_S = 0._EB
      DO NN=1,SF%N_MATL
         IF (PF%QUANTITY==SF%MATL_NAME(NN) .OR. PF%QUANTITY=='DENSITY') THEN
            DO I=1,NWP
               RHO_S(I) = RHO_S(I) + ONE_D%MATL_COMP(NN)%RHO(I)
            ENDDO
         ENDIF
      ENDDO
      RHO_S(0)     = RHO_S(1)
      RHO_S(NWP+1) = RHO_S(NWP)
      WRITE(LU_PROF(N),TCFORM) STIME,NWP+1,(X_S_NEW(I),I=0,NWP),(RHO_S(I)+DX_WGT_S(I)*(RHO_S(I+1)-RHO_S(I)),I=0,NWP)
   ENDIF

ENDDO PROF_LOOP

END SUBROUTINE DUMP_PROF


SUBROUTINE UPDATE_HRR(DT,NM)

! Integrate all the terms of the enthalpy transport equation over the entire domain.

! Q_DOT(1,NM) = int qdot''' dV
! Q_DOT(2,NM) = int del dot q_r'' dV
! Q_DOT(3,NM) = int u rho h_s dot dS
! Q_DOT(4,NM) = int k grad T dot dS
! Q_DOT(5,NM) = int sum h_s rho D grad Z dot dS
! Q_DOT(6,NM) = int dp/dt dV
! Q_DOT(7,NM) = int q_part dV
! Q_DOT(8,NM) = int d(rho h_s)/dt dV

USE PHYSICAL_FUNCTIONS, ONLY : GET_SPECIFIC_HEAT,GET_SENSIBLE_ENTHALPY,GET_SENSIBLE_ENTHALPY_Z
USE COMPLEX_GEOMETRY, ONLY : IBM_CGSC, IBM_GASPHASE, ADD_Q_DOT_CUTCELLS
REAL(EB), INTENT(IN) :: DT
REAL(EB) :: VC,U_N,ZZ_GET(1:N_TRACKED_SPECIES),H_S,H_S_ALPHA,H_S_J_ALPHA,CP,SPECIFIC_ENTHALPY_SUM_OLD
INTEGER, INTENT(IN) :: NM
INTEGER :: I,J,K,IW,IIG,JJG,KKG,N,I_FUEL,IND1,IND2,ICF,ICC,JCC
TYPE(WALL_TYPE), POINTER :: WC=>NULL()
TYPE(CFACE_TYPE),POINTER ::CFA=>NULL()


IF (EVACUATION_ONLY(NM)) RETURN

CALL POINT_TO_MESH(NM)

! Compute volume integral of certain quantities like the HRR

SPECIFIC_ENTHALPY_SUM_OLD = SPECIFIC_ENTHALPY_SUM(NM)
SPECIFIC_ENTHALPY_SUM(NM) = 0._EB

DO K=1,KBAR
   DO J=1,JBAR
      DO I=1,IBAR
         IF (SOLID(CELL_INDEX(I,J,K))) CYCLE
         IF(CC_IBM) THEN
            IF (CCVAR(I,J,K,IBM_CGSC)/=IBM_GASPHASE) CYCLE
         ENDIF
         IF (NM>1) THEN
            IF (INTERPOLATED_MESH(I,J,K)>0) CYCLE
         ENDIF
         VC = DX(I)*RC(I)*DY(J)*DZ(K)
         Q_DOT(1,NM) = Q_DOT(1,NM) + Q(I,J,K)*VC
         Q_DOT(2,NM) = Q_DOT(2,NM) + QR(I,J,K)*VC
         Q_DOT(6,NM) = Q_DOT(6,NM) + 0.5_EB*(D_PBAR_DT_S(PRESSURE_ZONE(I,J,K))+D_PBAR_DT(PRESSURE_ZONE(I,J,K)))*VC
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(I,J,K,1:N_TRACKED_SPECIES)
         CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,TMP(I,J,K))
         SPECIFIC_ENTHALPY_SUM(NM) = SPECIFIC_ENTHALPY_SUM(NM) + RHO(I,J,K)*H_S*VC
      ENDDO
   ENDDO
ENDDO

IF (CC_IBM) CALL ADD_Q_DOT_CUTCELLS(NM,Q_DOT(1,NM),Q_DOT(2,NM),Q_DOT(6,NM),SPECIFIC_ENTHALPY_SUM(NM))

IF (ICYC>0) THEN
   Q_DOT(8,NM) = (SPECIFIC_ENTHALPY_SUM(NM)-SPECIFIC_ENTHALPY_SUM_OLD)/DT
ELSE
   Q_DOT(8,NM) = 0._EB
ENDIF

! Compute the surface integral of all Del Dot terms

WALL_LOOP: DO IW=1,N_EXTERNAL_WALL_CELLS+N_INTERNAL_WALL_CELLS

   WC => WALL(IW)

   IF (WC%BOUNDARY_TYPE/=SOLID_BOUNDARY .AND. WC%BOUNDARY_TYPE/=OPEN_BOUNDARY) CYCLE WALL_LOOP

   IIG = WC%ONE_D%IIG
   JJG = WC%ONE_D%JJG
   KKG = WC%ONE_D%KKG

   IF (NM>1) THEN
      IF (INTERPOLATED_MESH(IIG,JJG,KKG)>0) CYCLE WALL_LOOP
   ENDIF

   SELECT CASE(WC%ONE_D%IOR)
      CASE( 1)
         U_N = -U(IIG-1,JJG,KKG)
      CASE(-1)
         U_N =  U(IIG,JJG,KKG)
      CASE( 2)
         U_N = -V(IIG,JJG-1,KKG)
      CASE(-2)
         U_N =  V(IIG,JJG,KKG)
      CASE( 3)
         U_N = -W(IIG,JJG,KKG-1)
      CASE(-3)
         U_N =  W(IIG,JJG,KKG)
   END SELECT

   ZZ_GET(1:N_TRACKED_SPECIES) = WC%ONE_D%ZZ_F(1:N_TRACKED_SPECIES)
   CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,WC%ONE_D%TMP_F)
   CALL GET_SPECIFIC_HEAT(ZZ_GET,CP,WC%ONE_D%TMP_F)
   H_S_J_ALPHA = 0._EB
   IF (N_TRACKED_SPECIES > 1) THEN
      DO N=1,N_TRACKED_SPECIES
         CALL GET_SENSIBLE_ENTHALPY_Z(N,WC%ONE_D%TMP_F,H_S_ALPHA)
         H_S_J_ALPHA = H_S_J_ALPHA + 2._EB*H_S_ALPHA*WC%ONE_D%RHO_D_F(N)*(ZZ(IIG,JJG,KKG,N)-WC%ONE_D%ZZ_F(N))*WC%ONE_D%RDN
      ENDDO
   ENDIF
   Q_DOT(3,NM) = Q_DOT(3,NM) - U_N*WC%ONE_D%RHO_F*H_S*WC%ONE_D%AREA
   Q_DOT(4,NM) = Q_DOT(4,NM) - WC%ONE_D%QCONF*WC%ONE_D%AREA
   Q_DOT(5,NM) = Q_DOT(5,NM) - H_S_J_ALPHA*WC%ONE_D%AREA
ENDDO WALL_LOOP

CFACE_LOOP : DO ICF=1,N_CFACE_CELLS

   CFA => CFACE(ICF)

   IF (CFA%BOUNDARY_TYPE/=SOLID_BOUNDARY) CYCLE CFACE_LOOP

   U_N = CFA%ONE_D%UW

   ! Find indexes of cut-cell that has this CFACE as boundary:
   IND1 = CFA%CUT_FACE_IND1;                         IND2 = CFA%CUT_FACE_IND2
   ICC  = CUT_FACE(IND1)%CELL_LIST(2,LOW_IND,IND2);  JCC  = CUT_FACE(IND1)%CELL_LIST(3,LOW_IND,IND2)

   ZZ_GET(1:N_TRACKED_SPECIES) = CFA%ONE_D%ZZ_F(1:N_TRACKED_SPECIES)
   CALL GET_SENSIBLE_ENTHALPY(ZZ_GET,H_S,CFA%ONE_D%TMP_F)
   CALL GET_SPECIFIC_HEAT(ZZ_GET,CP,CFA%ONE_D%TMP_F)
   H_S_J_ALPHA = 0._EB
   IF (N_TRACKED_SPECIES > 1) THEN
      DO N=1,N_TRACKED_SPECIES
         CALL GET_SENSIBLE_ENTHALPY_Z(N,CFA%ONE_D%TMP_F,H_S_ALPHA)
         H_S_J_ALPHA = H_S_J_ALPHA + 2._EB*H_S_ALPHA*CFA%ONE_D%RHO_D_F(N)*(CUT_CELL(ICC)%ZZ(N,JCC)-CFA%ONE_D%ZZ_F(N))*CFA%ONE_D%RDN
      ENDDO
   ENDIF
   Q_DOT(3,NM) = Q_DOT(3,NM) - U_N*CFA%ONE_D%RHO_F*H_S*CFA%ONE_D%AREA
   Q_DOT(4,NM) = Q_DOT(4,NM) - CFA%ONE_D%QCONF*CFA%ONE_D%AREA
   Q_DOT(5,NM) = Q_DOT(5,NM) - H_S_J_ALPHA*CFA%ONE_D%AREA

ENDDO CFACE_LOOP


! Determine mass loss rate of fuel, M_DOT(1,NM), and total, M_DOT(3,NM), from solid wall cells and then add it to the MLR of the
! particles.

M_DOT(1,NM) = 0._EB
M_DOT(3,NM) = 0._EB

I_FUEL = 0
IF (N_REACTIONS > 0) I_FUEL = REACTION(1)%FUEL_SMIX_INDEX

WALL_LOOP2: DO IW=1,N_EXTERNAL_WALL_CELLS+N_INTERNAL_WALL_CELLS
   WC => WALL(IW)
   IF (WC%BOUNDARY_TYPE/=SOLID_BOUNDARY) CYCLE WALL_LOOP2
   IF (I_FUEL>0) &
   M_DOT(1,NM) = M_DOT(1,NM) +     WC%ONE_D%MASSFLUX_SPEC(I_FUEL)*WC%ONE_D%AREA*WC%ONE_D%AREA_ADJUST
   M_DOT(3,NM) = M_DOT(3,NM) + SUM(WC%ONE_D%MASSFLUX_SPEC)       *WC%ONE_D%AREA*WC%ONE_D%AREA_ADJUST
ENDDO WALL_LOOP2

CFACE_LOOP_2 : DO ICF=1,N_CFACE_CELLS
   CFA => CFACE(ICF)
   IF (CFA%BOUNDARY_TYPE/=SOLID_BOUNDARY) CYCLE CFACE_LOOP_2
   IF (I_FUEL>0) &
   M_DOT(1,NM) = M_DOT(1,NM) +     CFA%ONE_D%MASSFLUX_SPEC(I_FUEL)*CFA%ONE_D%AREA ! No need for AREA_ADJUST.
   M_DOT(3,NM) = M_DOT(3,NM) + SUM(CFA%ONE_D%MASSFLUX_SPEC)       *CFA%ONE_D%AREA
ENDDO CFACE_LOOP_2

Q_DOT_SUM(:,NM) = Q_DOT_SUM(:,NM) + DT*Q_DOT(:,NM)
M_DOT_SUM(1,NM) = M_DOT_SUM(1,NM) + DT*SUM(M_DOT(1:2,NM))
M_DOT_SUM(2,NM) = M_DOT_SUM(2,NM) + DT*SUM(M_DOT(3:4,NM))

END SUBROUTINE UPDATE_HRR


SUBROUTINE DUMP_HRR(T,DT)

! Record HRR, etc, in the file CHID_hrr.csv

REAL(EB), INTENT(IN) :: T,DT
REAL(FB) :: STIME
INTEGER :: NM,I,N_ZONE_TMP
REAL(EB) :: Q_DOT_TOTAL(N_Q_DOT),M_DOT_TOTAL(2)
REAL(EB), DIMENSION(:), ALLOCATABLE ::  P_ZONE_P

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
Q_DOT_TOTAL = 0._EB
M_DOT_TOTAL = 0._EB

DO NM=1,NMESHES
   Q_DOT_TOTAL(:) = Q_DOT_TOTAL(:) + Q_DOT_SUM(:,NM)/MAX(DT,T-T_LAST_DUMP_HRR)
   M_DOT_TOTAL(1) = M_DOT_TOTAL(1) + M_DOT_SUM(1,NM)/MAX(DT,T-T_LAST_DUMP_HRR)
   M_DOT_TOTAL(2) = M_DOT_TOTAL(2) + M_DOT_SUM(2,NM)/MAX(DT,T-T_LAST_DUMP_HRR)
ENDDO

N_ZONE_TMP = 0
IF (N_ZONE>0) THEN
   ALLOCATE(P_ZONE_P(N_ZONE))
   DO I=1,N_ZONE
      IF (.NOT.P_ZONE(I)%EVACUATION) THEN
         N_ZONE_TMP = N_ZONE_TMP + 1
         P_ZONE_P(N_ZONE_TMP) = MESHES(1)%PBAR(1,I) - P_INF
      ENDIF
   ENDDO
ENDIF

WRITE(TCFORM,'(A,I4.4,5A)') "(",11+N_ZONE_TMP,"(",FMT_R,",','),",FMT_R,")"
IF (N_ZONE_TMP>0) THEN
   WRITE(LU_HRR,TCFORM) STIME,0.001_EB*Q_DOT_TOTAL(1:N_Q_DOT),0.001_EB*SUM(Q_DOT_TOTAL(1:N_Q_DOT-1)),&
                        M_DOT_TOTAL(1:2),(P_ZONE_P(I),I=1,N_ZONE_TMP)
ELSE
   WRITE(LU_HRR,TCFORM) STIME,0.001_EB*Q_DOT_TOTAL(1:N_Q_DOT),0.001_EB*SUM(Q_DOT_TOTAL(1:N_Q_DOT-1)),&
                        M_DOT_TOTAL(1:2)
ENDIF

IF (N_ZONE>0) DEALLOCATE(P_ZONE_P)

END SUBROUTINE DUMP_HRR


SUBROUTINE UPDATE_MASS(DT,NM)

! Compute the total masses of various gases

USE PHYSICAL_FUNCTIONS, ONLY : GET_MASS_FRACTION_ALL
REAL(EB) :: VC,Y_MF_INT(1:N_SPECIES),ZZ_GET(1:N_TRACKED_SPECIES)
REAL(EB), INTENT(IN) :: DT
INTEGER, INTENT(IN) :: NM
INTEGER :: I,J,K

IF (.NOT.MASS_FILE) RETURN

IF (EVACUATION_ONLY(NM)) RETURN

MINT(:,NM) = 0._EB
CALL POINT_TO_MESH(NM)
DO K=1,KBAR
   DO J=1,JBAR
      DO I=1,IBAR
         IF (SOLID(CELL_INDEX(I,J,K))) CYCLE
         IF (NM>1) THEN
            IF (INTERPOLATED_MESH(I,J,K)/=0) CYCLE
         ENDIF
         VC = DX(I)*RC(I)*DY(J)*DZ(K)
         MINT(0,NM) = MINT(0,NM) + VC*RHO(I,J,K)
         ZZ_GET(1:N_TRACKED_SPECIES) = ZZ(I,J,K,1:N_TRACKED_SPECIES)
         CALL GET_MASS_FRACTION_ALL(ZZ_GET,Y_MF_INT)
         MINT(1:N_SPECIES,NM) = MINT(1:N_SPECIES,NM) + RHO(I,J,K)*Y_MF_INT(1:N_SPECIES)*VC
      ENDDO
   ENDDO
ENDDO

MINT_SUM(:,NM) = MINT_SUM(:,NM) + DT*MINT(:,NM)

END SUBROUTINE UPDATE_MASS


SUBROUTINE DUMP_MASS(T,DT)

REAL(EB), INTENT(IN) :: T,DT
REAL(FB) :: STIME
REAL(EB) :: MINT_TOTAL(0:N_SPECIES)
INTEGER :: NM,N

IF (.NOT.MASS_FILE) RETURN

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)
MINT_TOTAL(:) = 0._EB

DO NM=1,NMESHES
   MINT_TOTAL(0:N_SPECIES) = MINT_TOTAL(0:N_SPECIES) + MINT_SUM(0:N_SPECIES,NM)/MAX(DT,T-T_LAST_DUMP_MASS)
ENDDO

WRITE(TCFORM,'(A,I4.4,5A)') "(",N_SPECIES+1,"(",FMT_R,",','),",FMT_R,")"
WRITE(LU_MASS,TCFORM) STIME,(MINT_TOTAL(N),N=0,N_SPECIES)

END SUBROUTINE DUMP_MASS


SUBROUTINE DUMP_BNDF(T,NM)

! Dump boundary quantities into CHID_nn.bf file

REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER :: ISUM,NF,IND,I,J,K,IC,IW,L,L1,L2,N,N1,N2,IP,NC,I1,I2,J1,J2,K1,K2
INTEGER, INTENT(IN) :: NM
TYPE(PATCH_TYPE), POINTER :: PA

IF (MESHES(NM)%N_PATCH==0 .AND. MESHES(NM)%N_CFACE_CELLS==0) RETURN
IF (EVACUATION_ONLY(NM))  RETURN

FROM_BNDF = .TRUE.

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)

CALL POINT_TO_MESH(NM)

FILE_LOOP: DO NF=1,N_BNDF
   IF (N_PATCH == 0) CYCLE FILE_LOOP
   BF => BOUNDARY_FILE(NF)
   PY => PROPERTY(BF%PROP_INDEX)
   WRITE(LU_BNDF(NF,NM)) STIME
   IND  = ABS(BF%INDEX)
   NC = 0

   PATCH_LOOP: DO IP=1,N_PATCH

      PA => PATCH(IP)

      PP  = REAL(OUTPUT_QUANTITY(-IND)%AMBIENT_VALUE,FB)
      PPN = 0._FB
      IBK = 0

      ! Adjust PATCH indices depending on orientation

      SELECT CASE(ABS(PA%IOR))
         CASE(1) ; L1=PA%JG1 ; L2=PA%JG2 ; N1=PA%KG1 ; N2=PA%KG2
         CASE(2) ; L1=PA%IG1 ; L2=PA%IG2 ; N1=PA%KG1 ; N2=PA%KG2
         CASE(3) ; L1=PA%IG1 ; L2=PA%IG2 ; N1=PA%JG1 ; N2=PA%JG2
      END SELECT

      ! Evaluate the given boundary quantity at each cell of the current PATCH

      DO K=PA%KG1,PA%KG2
         DO J=PA%JG1,PA%JG2
            DO I=PA%IG1,PA%IG2
               IC = CELL_INDEX(I,J,K)
               IW = WALL_INDEX(IC,-PA%IOR) ; IF (IW==0) CYCLE
               SELECT CASE(ABS(PA%IOR))
                  CASE(1) ; L=J ; N=K
                  CASE(2) ; L=I ; N=K
                  CASE(3) ; L=I ; N=J
               END SELECT
               IF (WALL(IW)%BOUNDARY_TYPE/=NULL_BOUNDARY .AND. &
                   WALL(IW)%BOUNDARY_TYPE/=INTERPOLATED_BOUNDARY .AND. .NOT.SOLID(IC)) THEN
                  IBK(L,N) = 1
                  PP(L,N)  = REAL(SOLID_PHASE_OUTPUT(NM,IND,BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,OPT_WALL_INDEX=IW),FB)
               ENDIF
            ENDDO
         ENDDO
      ENDDO

      ! Integrate the boundary quantity in time

      IF (BF%TIME_INTEGRAL_INDEX>0) THEN
         DO N=N1,N2
            DO L=L1,L2
               NC = NC + 1
               BNDF_TIME_INTEGRAL(NC,BF%TIME_INTEGRAL_INDEX) = BNDF_TIME_INTEGRAL(NC,BF%TIME_INTEGRAL_INDEX) + &
                                                               PP(L,N)*REAL(DT_BNDF,FB)
               PP(L,N) = BNDF_TIME_INTEGRAL(NC,BF%TIME_INTEGRAL_INDEX)
            ENDDO
         ENDDO
      ENDIF

      ! Interpolate the boundary quantity PP at cell corners, PPN

      IF (.NOT.BF%CELL_CENTERED) THEN
         DO N=N1-1,N2
            DO L=L1-1,L2
               IF (IBK(L,N)==1)     PPN(L,N) = PPN(L,N) + PP(L,N)
               IF (IBK(L+1,N)==1)   PPN(L,N) = PPN(L,N) + PP(L+1,N)
               IF (IBK(L,N+1)==1)   PPN(L,N) = PPN(L,N) + PP(L,N+1)
               IF (IBK(L+1,N+1)==1) PPN(L,N) = PPN(L,N) + PP(L+1,N+1)
               ISUM = IBK(L,N)+IBK(L,N+1)+IBK(L+1,N)+IBK(L+1,N+1)
               IF (ISUM>0) THEN
                  PPN(L,N) = PPN(L,N)/REAL(ISUM,FB)
               ELSE
                  PPN(L,N) = REAL(SOLID_PHASE_OUTPUT(NM,IND,BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,OPT_WALL_INDEX=0),FB)
               ENDIF
            ENDDO
         ENDDO
         IF (BF%DEBUG .EQ. 0) THEN
            WRITE(LU_BNDF(NF,NM)) ((PPN(L,N),L=L1-1,L2),N=N1-1,N2)
         ELSE
            WRITE(LU_BNDF(NF,NM)) ((REAL(100*NM,FB),L=L1-1,L2),N=N1-1,N2)
         ENDIF

      ELSE
         IF (BF%DEBUG .EQ. 0) THEN
            WRITE(LU_BNDF(NF,NM)) ((PP(L,N),L=L1,L2+1),N=N1,N2+1)
         ELSE
            WRITE(LU_BNDF(NF,NM)) ((REAL(100*NM,FB),L=L1-1,L2),N=N1-1,N2)
         ENDIF
      ENDIF

   ENDDO PATCH_LOOP

ENDDO FILE_LOOP

IF (CC_IBM) THEN
   FILE_LOOP2 : DO NF=1,N_BNDF
      BF => BOUNDARY_FILE(NF)
      PY => PROPERTY(BF%PROP_INDEX)
      IND  = ABS(BF%INDEX)
      NC = 0
      I1=0; I2=-1; J1=0; J2=-1; K1=0; K2=-1; ! Just dummy numbers, not needed for INBOUND_FACES
      ! write geometry for slice file
      IF (ABS(STIME-T_BEGIN)<TWO_EPSILON_EB) THEN
         ! geometry and data file at first time step
         OPEN(LU_BNDF_GEOM(NF,NM),FILE=FN_BNDF_GEOM(NF,NM),FORM='UNFORMATTED',STATUS='REPLACE')
         CALL DUMP_SLICE_GEOM(LU_BNDF_GEOM(NF,NM),"INBOUND_FACES",1,STIME,I1,I2,J1,J2,K1,K2)
         CLOSE(LU_BNDF_GEOM(NF,NM))

         OPEN(LU_BNDG(NF,NM),FILE=FN_BNDG(NF,NM),FORM='UNFORMATTED',STATUS='REPLACE')
         CALL DUMP_SLICE_GEOM_DATA(NM,LU_BNDG(NF,NM),.FALSE.,.FALSE.,"INBOUND_FACES",1,STIME,I1,I2,J1,J2,K1,K2, &
                                   IND,BF%Y_INDEX,BF%Z_INDEX,BF%DEBUG)
         CLOSE(LU_BNDG(NF,NM))
      ELSE
         ! data file at subsequent time steps
         OPEN(LU_BNDG(NF,NM),FILE=FN_BNDG(NF,NM),FORM='UNFORMATTED',STATUS='OLD',POSITION='APPEND')
         CALL DUMP_SLICE_GEOM_DATA(NM,LU_BNDG(NF,NM),.FALSE.,.FALSE.,"INBOUND_FACES",0,STIME,I1,I2,J1,J2,K1,K2, &
                                   IND,BF%Y_INDEX,BF%Z_INDEX,BF%DEBUG)
         CLOSE(LU_BNDG(NF,NM))
      ENDIF
   ENDDO FILE_LOOP2
ENDIF

FROM_BNDF = .FALSE.

END SUBROUTINE DUMP_BNDF


SUBROUTINE DUMP_GEOM(T)

!! under construction !!

! Dump boundary quantities into CHID_nn.ge file
REAL(EB), INTENT(IN) :: T
REAL(EB) :: STIME

STIME = T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR

CALL WRITE_GEOM(STIME)

END SUBROUTINE DUMP_GEOM


SUBROUTINE DUMP_GEOM_DIAG(STIME)
   REAL(EB), INTENT(IN) :: STIME

   REAL(FB) :: VERTS(9), VERTDATA(3), TRIDATA(1)
   INTEGER :: TRIANGLES(3), NVERTS, NTRIANGLES, NVERTDATA, NTRIDATA

! for now only output diagnostic data once at the beginning of a simulation
   IF (ABS(STIME-T_BEGIN)<TWO_EPSILON_EB)RETURN

! dummy example - 1 triangle
   NVERTS = 3
   NTRIANGLES = 1
   NVERTDATA = 0
   NTRIDATA = 1
   VERTS(1:9)=(/0.0_FB,0.0_FB,0.0_FB,1.0_FB,0.0_FB,0.0_FB,1.0_FB,0.0_FB,1.0_FB/)
   TRIANGLES(1:3)=(/1,2,3/)
   TRIDATA(1) = 1.0_FB
   CALL WRITE_GEOM_DATA(VERTS, NVERTS, TRIANGLES, NTRIANGLES, VERTDATA, NVERTDATA, TRIDATA, NTRIDATA)
END SUBROUTINE DUMP_GEOM_DIAG


SUBROUTINE DUMP_BNDF_TO_SLCF(T,NM)

! Project boundary surface onto a plane and output as a slice file to CHID_nn_bf.sf file

REAL(EB), INTENT(IN) :: T
REAL(FB) :: STIME
INTEGER :: ISUM,KG,IOR,NF,IND,I,J,K,I1,I2,J1,J2,K1,K2,IC,IW,N
INTEGER, INTENT(IN) :: NM

IF (MESHES(NM)%N_PATCH==0) RETURN

IF (EVACUATION_ONLY(NM)) RETURN

FROM_BNDF = .TRUE.

STIME = REAL(T_BEGIN + (T-T_BEGIN)*TIME_SHRINK_FACTOR,FB)

CALL POINT_TO_MESH(NM)

FLOOP: DO NF=1,N_BNDF

   BF => BOUNDARY_FILE(NF)
   PY => PROPERTY(BF%PROP_INDEX)
   WRITE(LU_BNDF_SLCF(NF,NM)) STIME
   IND  = ABS(BF%INDEX)

   ! Exterior walls

   IOR=3

   PP  = 100._FB
   PPN = 100._FB

   IF (INC(IOR,0)/=0) THEN
      KG=1
      DO J=1,JBAR
         DO I=1,IBAR
            IC = CELL_INDEX(I,J,KG)
            IW = WALL_INDEX(IC,-IOR)
            PP(I,J) = REAL(SOLID_PHASE_OUTPUT(NM,IND,BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,OPT_WALL_INDEX=IW),FB)
         ENDDO
      ENDDO
   ENDIF

! Interior obstructions

   BLOOP: DO N=1,N_OBST
      OB=>OBSTRUCTION(N)
      I1 = OB%I1+1
      I2 = OB%I2
      J1 = OB%J1+1
      J2 = OB%J2
      K1 = OB%K1+1
      K2 = OB%K2

      IOR=3

      IF (INC(IOR,N)/=0) THEN

         K=K2+1
         DO J=J1,J2
            DO I=I1,I2
               IC = CELL_INDEX(I,J,K)
               IW = WALL_INDEX(IC,-IOR)
               PP(I,J) = REAL(SOLID_PHASE_OUTPUT(NM,IND,BF%Y_INDEX,BF%Z_INDEX,BF%PART_INDEX,OPT_WALL_INDEX=IW),FB)
            ENDDO
         ENDDO
      ENDIF
   ENDDO BLOOP

   IF (.NOT.BF%CELL_CENTERED) THEN
      PPN=0.0_FB
      DO J=0,JBAR
         DO I=0,IBAR
            ISUM=0
            IF (I/=0 .AND. J/=0) THEN
              PPN(I,J) = PPN(I,J) + PP(I,J)
              ISUM = ISUM + 1
            ENDIF
            IF (I/=IBAR .AND. J/=0) THEN
              PPN(I,J) = PPN(I,J) + PP(I+1,J)
              ISUM = ISUM + 1
            ENDIF
            IF (I/=0 .AND. J/=JBAR) THEN
              PPN(I,J) = PPN(I,J) + PP(I,J+1)
              ISUM = ISUM + 1
            ENDIF
            IF (I/=IBAR .AND. J/=JBAR) THEN
              PPN(I,J) = PPN(I,J) + PP(I+1,J+1)
              ISUM = ISUM + 1
            ENDIF
            IF (ISUM>0) THEN
              PPN(I,J)=PPN(I,J)/ISUM
            ELSE
              PPN(I,J)=PP(I,J)
            ENDIF
         ENDDO
      ENDDO
      WRITE(LU_BNDF_SLCF(NF,NM)) ((PPN(I,J),I=0,IBAR),J=0,JBAR)
   ELSE
      WRITE(LU_BNDF_SLCF(NF,NM)) ((PP(I,J),I=1,IBAR+1),J=1,JBAR+1)
   ENDIF
ENDDO FLOOP

FROM_BNDF = .FALSE.

END SUBROUTINE DUMP_BNDF_TO_SLCF


SUBROUTINE FLUSH_GLOBAL_BUFFERS

! Periodically purge output files

INTEGER :: N
REAL(EB) :: TNOW

TNOW = CURRENT_TIME()

INQUIRE(UNIT=LU_SMV,OPENED=OPN)
IF (OPN) FLUSH(LU_SMV)
INQUIRE(UNIT=LU_OUTPUT,OPENED=OPN)
IF (OPN) FLUSH(LU_OUTPUT)

DO N=1,N_DEVC_FILES
   INQUIRE(UNIT=LU_DEVC(N),OPENED=OPN)
   IF (OPN) FLUSH(LU_DEVC(N))
ENDDO

DO N=1,N_CTRL_FILES
   INQUIRE(UNIT=LU_CTRL(N),OPENED=OPN)
   IF (OPN) FLUSH(LU_CTRL(N))
ENDDO

INQUIRE(UNIT=LU_HRR,OPENED=OPN)
IF (OPN) FLUSH(LU_HRR)

IF (MASS_FILE) THEN
   INQUIRE(UNIT=LU_MASS,OPENED=OPN)
   IF (OPN) FLUSH(LU_MASS)
ENDIF

IF (VELOCITY_ERROR_FILE) THEN
   INQUIRE(UNIT=LU_VELOCITY_ERROR,OPENED=OPN)
   IF (OPN) FLUSH(LU_VELOCITY_ERROR)
ENDIF

IF (CFL_FILE) THEN
   INQUIRE(UNIT=LU_CFL,OPENED=OPN)
   IF (OPN) FLUSH(LU_CFL)
ENDIF

DO N=1,N_BNDE
   INQUIRE(UNIT=LU_BNDE(N),OPENED=OPN)
   IF (OPN) FLUSH(LU_BNDE(N))
ENDDO

IF (N_BNDE>0) THEN
   DO N=1,1
      INQUIRE(UNIT=LU_GEOM(N),OPENED=OPN)
      IF (OPN) FLUSH(LU_GEOM(N))
   ENDDO
ENDIF

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE FLUSH_GLOBAL_BUFFERS


SUBROUTINE FLUSH_EVACUATION_BUFFERS

! Periodically purge output files

USE EVAC, ONLY : EMESH_INDEX
IMPLICIT NONE
INTEGER :: NM,N
REAL(EB) :: TNOW

TNOW = CURRENT_TIME()

IF (ANY(EVACUATION_ONLY)) THEN
   INQUIRE(UNIT=LU_EVACCSV,OPENED=OPN)
   IF (OPN) FLUSH(LU_EVACCSV)
   INQUIRE(UNIT=LU_EVACOUT,OPENED=OPN)
   IF (OPN)    FLUSH(LU_EVACOUT)
   IF (BTEST(I_EVAC,0)) THEN
      INQUIRE(UNIT=LU_EVACEFF,OPENED=OPN)
      IF (OPN) FLUSH(LU_EVACEFF)
   ENDIF
   IF (BTEST(I_EVAC,1)) THEN
      INQUIRE(UNIT=LU_EVACFED,OPENED=OPN)
      IF (OPN) FLUSH(LU_EVACFED)
   ENDIF

   DO NM=1,NMESHES
      IF (EMESH_INDEX(NM)==0) CYCLE
      INQUIRE(UNIT=LU_PART(NM),OPENED=OPN)
      IF (OPN) FLUSH(LU_PART(NM))
      DO N=1,MESHES(NM)%N_SLCF
         INQUIRE(UNIT=LU_SLCF(N,NM),OPENED=OPN)
         IF (OPN) FLUSH(LU_SLCF(N,NM))
      ENDDO
   ENDDO

ENDIF

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE FLUSH_EVACUATION_BUFFERS


SUBROUTINE FLUSH_LOCAL_BUFFERS(NM)

! Periodically purge output files

INTEGER, INTENT(IN) :: NM
INTEGER :: N
REAL(EB) :: TNOW

TNOW = CURRENT_TIME()

IF (PARTICLE_FILE) THEN
   INQUIRE(UNIT=LU_PART(NM),OPENED=OPN)
   IF (OPN) FLUSH(LU_PART(NM))
ENDIF

DO N=1,MESHES(NM)%N_SLCF
   INQUIRE(UNIT=LU_SLCF(N,NM),OPENED=OPN)
   IF (OPN) FLUSH(LU_SLCF(N,NM))
ENDDO

DO N=1,N_ISOF
   INQUIRE(UNIT=ABS(LU_ISOF(N,NM)),OPENED=OPN)
   IF (OPN) FLUSH(ABS(LU_ISOF(N,NM)))
   INQUIRE(UNIT=ABS(LU_ISOF2(N,NM)),OPENED=OPN)
   IF (OPN) FLUSH(ABS(LU_ISOF2(N,NM)))
ENDDO

DO N=1,4
   INQUIRE(UNIT=ABS(LU_SMOKE3D(N,NM)),OPENED=OPN)
   IF (OPN) FLUSH(ABS(LU_SMOKE3D(N,NM)))
END DO

DO N=1,N_BNDF
   INQUIRE(UNIT=LU_BNDF(N,NM),OPENED=OPN)
   IF (OPN) FLUSH(LU_BNDF(N,NM))
ENDDO

IF (TERRAIN_CASE) THEN
   DO N=1,N_BNDF
      INQUIRE(UNIT=LU_BNDF_SLCF(N,NM),OPENED=OPN)
      IF (OPN) FLUSH(LU_BNDF_SLCF(N,NM))
   ENDDO
ENDIF

DO N=1,N_PROF
   IF (PROFILE(N)%MESH==NM) THEN
      INQUIRE(UNIT=LU_PROF(N),OPENED=OPN)
      IF (OPN) FLUSH(LU_PROF(N))
   ENDIF
ENDDO

T_USED(7) = T_USED(7) + CURRENT_TIME() - TNOW
END SUBROUTINE FLUSH_LOCAL_BUFFERS


SUBROUTINE TIMINGS

! Print out detector activation times and total elapsed time into .out file.

USE COMP_FUNCTIONS, ONLY: CURRENT_TIME
REAL(EB) :: T_NOW
INTEGER :: N
LOGICAL :: WRITE_HEADER
TYPE(CONTROL_TYPE), POINTER :: CF=>NULL()

! Print out detector and control activation times

IF (N_DEVC > 0) THEN
   WRITE_HEADER = .TRUE.
   DO N=1,N_DEVC
      DV => DEVICE(N)
      IF (DV%SETPOINT>1.E6_EB) CYCLE
      IF (WRITE_HEADER)             WRITE(LU_OUTPUT,'(//A/)')   ' DEVICE Activation Times' ; WRITE_HEADER = .FALSE.
      IF (DV%T_CHANGE < 100000._EB) WRITE(LU_OUTPUT,'(I4,2X,A,F8.1,A)') N,DV%ID,DV%T_CHANGE,' s'
      IF (DV%T_CHANGE > 100000._EB) WRITE(LU_OUTPUT,'(I4,2X,A,A)')      N,DV%ID,'No Activation'
   ENDDO
ENDIF

IF (N_CTRL > 0) THEN
   WRITE(LU_OUTPUT,'(//A/)')   ' CONTROL Activation Times'
   DO N=1,N_CTRL
      CF => CONTROL(N)
      IF (CF%T_CHANGE < 100000._EB) WRITE(LU_OUTPUT,'(I4,2X,A,L1,F8.1,A)') N,CF%ID,CF%CURRENT_STATE,CF%T_CHANGE,' s'
      IF (CF%T_CHANGE > 100000._EB) WRITE(LU_OUTPUT,'(I4,2X,A,L1,A)')      N,CF%ID,CF%CURRENT_STATE,' No Activation'
   ENDDO
ENDIF

! Printout elapsed wall clock time

IF (ICYC>0) THEN
   T_NOW = CURRENT_TIME()
   WRITE(LU_OUTPUT,'(//A,F12.3)') ' Time Stepping Wall Clock Time (s): ',T_NOW - WALL_CLOCK_START_ITERATIONS
   WRITE(LU_OUTPUT,'(  A,F12.3)') ' Total Elapsed Wall Clock Time (s): ',T_NOW - WALL_CLOCK_START
ENDIF

END SUBROUTINE TIMINGS


SUBROUTINE GET_LAYER_HEIGHT_INTEGRALS(II,JJ,K_LO,K_HI,Z_INT,Z_LO,I_1,I_2,I_3,TMP_LOW)

! Compute the integrals needed for layer height, average upper and lower layer temperatures

INTEGER, INTENT(IN) :: II,JJ,K_LO,K_HI
REAL(EB), INTENT(OUT) :: I_1,I_2,I_3,TMP_LOW
REAL(EB), INTENT(IN)  :: Z_LO,Z_INT
INTEGER :: K

I_1 = 0._EB
I_2 = 0._EB
I_3 = 0._EB
DO K=K_LO,K_HI
   I_1 = I_1 + DZ(K)*TMP(II,JJ,K)
   I_2 = I_2 + DZ(K)/TMP(II,JJ,K)
   IF (Z(K-1)-Z_LO>=Z_INT) THEN
      I_3 = I_3 + TMP(II,JJ,K)*DZ(K)
   ELSEIF (Z(K)-Z_LO>Z_INT) THEN
      I_3 = I_3 + TMP(II,JJ,K)  *(Z(K)-Z_LO-Z_INT)
   ELSE
   ENDIF
ENDDO
TMP_LOW = TMP(II,JJ,K_LO)

END SUBROUTINE GET_LAYER_HEIGHT_INTEGRALS


SUBROUTINE COMPUTE_PARTICLE_FLUXES(NM)

INTEGER, INTENT(IN) :: NM
INTEGER :: II,JJ,KK,IP
REAL(EB) :: DROPMASS,RVC

CALL POINT_TO_MESH(NM)

WFX => WORK4 ; WFX = 0._EB
WFY => WORK5 ; WFY = 0._EB
WFZ => WORK6 ; WFZ = 0._EB

DO IP=1,NLP
   LP=>LAGRANGIAN_PARTICLE(IP)
   LPC=>LAGRANGIAN_PARTICLE_CLASS(LP%CLASS_INDEX)
   IF (LP%X<=XS) CYCLE
   IF (LP%X>=XF) CYCLE
   IF (LP%Y<=YS) CYCLE
   IF (LP%Y>=YF) CYCLE
   IF (LP%Z<=ZS) CYCLE
   IF (LP%Z>=ZF) CYCLE
   II = LP%ONE_D%IIG
   JJ = LP%ONE_D%JJG
   KK = LP%ONE_D%KKG
   DROPMASS = LP%PWT*LPC%FTPR*MAXVAL(LP%ONE_D%X)**3
   RVC = RDX(II)*RRN(II)*RDY(JJ)*RDZ(KK)
   WFX(II,JJ,KK) = WFX(II,JJ,KK) + DROPMASS*LP%U*RVC
   WFY(II,JJ,KK) = WFY(II,JJ,KK) + DROPMASS*LP%V*RVC
   WFZ(II,JJ,KK) = WFZ(II,JJ,KK) + DROPMASS*LP%W*RVC
ENDDO

WFX(:,:,0) = WFX(:,:,1)
WFY(:,:,0) = WFY(:,:,1)
WFZ(:,:,0) = WFZ(:,:,1)

END SUBROUTINE COMPUTE_PARTICLE_FLUXES


REAL(EB) FUNCTION WAVELET_ERROR_MEASURE(II,JJ,KK,IND,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,DT,NM)
IMPLICIT NONE
REAL(EB), INTENT(IN) :: DT
INTEGER, INTENT(IN) :: II,JJ,KK,IND,NM,VELO_INDEX,Y_INDEX,Z_INDEX,PART_INDEX
REAL(EB) :: SS(4)

! wavelet error measure
WAVELET_ERROR_MEASURE = 0._EB

SS(1) = GAS_PHASE_OUTPUT(MAX(0,II-2),JJ,KK,              IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
SS(2) = GAS_PHASE_OUTPUT(MAX(0,II-1),JJ,KK,              IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
SS(3) = GAS_PHASE_OUTPUT(II,JJ,KK,                       IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
SS(4) = GAS_PHASE_OUTPUT(MIN(MESHES(NM)%IBP1,II+1),JJ,KK,IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
WAVELET_ERROR_MEASURE = WAVELET_ERROR(SS)

IF (.NOT.TWO_D) THEN
   SS(1) = GAS_PHASE_OUTPUT(II,MAX(0,JJ-2),KK,              IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
   SS(2) = GAS_PHASE_OUTPUT(II,MAX(0,JJ-1),KK,              IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
   SS(3) = GAS_PHASE_OUTPUT(II,JJ,KK,                       IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
   SS(4) = GAS_PHASE_OUTPUT(II,MIN(MESHES(NM)%JBP1,JJ+1),KK,IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
   WAVELET_ERROR_MEASURE = MAX(WAVELET_ERROR_MEASURE,WAVELET_ERROR(SS))
ENDIF

SS(1) = GAS_PHASE_OUTPUT(II,JJ,MAX(0,KK-2),              IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
SS(2) = GAS_PHASE_OUTPUT(II,JJ,MAX(0,KK-1),              IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
SS(3) = GAS_PHASE_OUTPUT(II,JJ,KK,                       IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
SS(4) = GAS_PHASE_OUTPUT(II,JJ,MIN(MESHES(NM)%KBP1,KK+1),IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0,0._EB,DT,NM)
WAVELET_ERROR_MEASURE = MAX(WAVELET_ERROR_MEASURE,WAVELET_ERROR(SS))

END FUNCTION WAVELET_ERROR_MEASURE


REAL(EB) FUNCTION WAVELET_ERROR(S)
IMPLICIT NONE

INTEGER, PARAMETER :: M=2 ! only need two level transform, but could be generalized
REAL(EB), INTENT(IN) :: S(2*M)
REAL(EB) :: SS(2*M),A(M,M)=0._EB,C(M,M)=0._EB,C1,C2,SMIN,SMAX,DS
INTEGER :: I,J,K,N

! Comments: This function generates a normalized error measure WAVELET_ERROR based on coefficients
! from a simple Haar wavelet transform.  The function requires the input of 4 scalar values.  The
! error is estimated at the point of the value S(3) based on a piece-wise constant reconstruction
! of the underlying function.  For example...
!
!     |<---------- interval --------->|
!
!            S(2)
!             o-------       S(4)
!    S(1)                     o-------
!     o-------
!                    S(3)
!                     o-------
!                     ^
!                     |
!             error computed here

! normalize signal
SMAX=MAXVAL(S)
SMIN=MINVAL(S)
DS=SMAX-SMIN
IF (DS<1.E-6) THEN
   WAVELET_ERROR = 0._EB
   RETURN
ELSE
   SS=(S-SMIN)/DS
ENDIF

! discrete Haar wavelet transform
N=M
DO I=1,M
   DO J=1,N
      K=2*J-1
      IF (I==1) THEN
         A(I,J) = 0.5_EB*(SS(K)+SS(K+1))
         C(I,J) = 0.5_EB*(SS(K)-SS(K+1))
      ELSE
         A(I,J) = 0.5_EB*(A(I-1,K)+A(I-1,K+1))
         C(I,J) = 0.5_EB*(A(I-1,K)-A(I-1,K+1))
      ENDIF
   ENDDO
   N=N/2;
ENDDO

C1 = SUM(C(1,:))
C2 = SUM(C(2,:))

WAVELET_ERROR = ABS(C1-C2)

END FUNCTION WAVELET_ERROR


!!! These RESOLUTION metrics need to be reworked to properly account for TKE !!!

! REAL(EB) FUNCTION MEASURE_SCALAR_RESOLUTION(II,JJ,KK,IND,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,NM)
! IMPLICIT NONE

! INTEGER, INTENT(IN) :: II,JJ,KK,IND,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,NM
! REAL(EB) :: T_TOT,T_LES,T_SGS,ZZ(3,3,3),ZZ_HAT
! INTEGER :: I,J,K,LL,MM,NN
! REAL(EB), PARAMETER :: C(1:3)=(/0.25_EB,0.5_EB,0.25_EB/)

! ! References:
! !
! ! L. Vervisch, P. Domingo, G. Lodato, D. Veynante. Scalar energy fluctuations in Large-Eddy Simulation of
! ! turbulent flames: Statistical budgets and mesh quality criterion. Combust. Flame, 157 (2010) 778-789.

! MEASURE_SCALAR_RESOLUTION = 0._EB

! DO K=KK-1,KK+1
!    NN=MIN(MESHES(NM)%KBP1,MAX(0,K))
!    DO J=JJ-1,JJ+1
!       MM=MIN(MESHES(NM)%JBP1,MAX(0,J))
!       DO I=II-1,II+1
!          LL=MIN(MESHES(NM)%IBP1,MAX(0,I))

!          ZZ(I-II+2,J-JJ+2,K-KK+2) = GAS_PHASE_OUTPUT(LL,MM,NN,IND,0,Y_INDEX,Z_INDEX,PART_INDEX,VELO_INDEX,0,0,0,0._EB,NM)
!       ENDDO
!    ENDDO
! ENDDO

! ZZ_HAT = 0._EB
! DO K=1,3
!    DO J=1,3
!       DO I=1,3
!          ZZ_HAT = ZZ_HAT + C(I)*C(J)*C(K)*ZZ(I,J,K)
!       ENDDO
!    ENDDO
! ENDDO

! T_LES = ZZ(2,2,2)**2
! T_SGS = (ZZ(2,2,2)-ZZ_HAT)**2
! T_TOT = T_LES + T_SGS

! IF (T_TOT>SCALAR_ENERGY_TOLERANCE) MEASURE_SCALAR_RESOLUTION = T_SGS/T_TOT

! END FUNCTION MEASURE_SCALAR_RESOLUTION


! REAL(EB) FUNCTION MEASURE_TURBULENCE_RESOLUTION(II,JJ,KK,NM)
! USE PHYSICAL_FUNCTIONS, ONLY: LES_FILTER_WIDTH_FUNCTION
! IMPLICIT NONE

! INTEGER, INTENT(IN) :: II,JJ,KK,NM
! REAL(EB) :: K_SGS,K_TOT,DELTA
! TYPE(MESH_TYPE), POINTER :: M=>NULL()

! M => MESHES(NM)
! DELTA = LES_FILTER_WIDTH_FUNCTION(M%DX(II),M%DY(JJ),M%DZ(KK))
! K_SGS = SUBGRID_KINETIC_ENERGY(M%MU(II,JJ,KK),M%RHO(II,JJ,KK),C_DEARDORFF,DELTA)
! K_TOT = M%KRES(II,JJ,KK) + K_SGS

! IF (K_TOT>TWO_EPSILON_EB) THEN
!    MEASURE_TURBULENCE_RESOLUTION=K_SGS/K_TOT
! ELSE
!    MEASURE_TURBULENCE_RESOLUTION=0._EB
! ENDIF

! END FUNCTION MEASURE_TURBULENCE_RESOLUTION


REAL(EB) FUNCTION SUBGRID_KINETIC_ENERGY(MU_TURB,RHO,C_NU,DELTA)

! back out k_sgs (subgrid kinetic energy per unit mass) from Deardorff eddy viscosity

REAL(EB), INTENT(IN) :: MU_TURB,RHO,C_NU,DELTA
REAL(EB) :: DENOM

DENOM = RHO*C_NU*DELTA
IF (DENOM>TWO_EPSILON_EB) THEN
   SUBGRID_KINETIC_ENERGY = (MAX(MU_TURB,0._EB)/DENOM)**2
ELSE
   SUBGRID_KINETIC_ENERGY = 0._EB
ENDIF

END FUNCTION SUBGRID_KINETIC_ENERGY


SUBROUTINE DUMP_UVW(NM,FN_UVW)

! Dump UVW file

USE COMP_FUNCTIONS, ONLY: GET_FILE_NUMBER
INTEGER  :: I,J,K,LU_UVW,IMIN,JMIN,KMIN,IMAX,JMAX,KMAX
INTEGER, INTENT(IN) :: NM
CHARACTER(80), INTENT(IN) :: FN_UVW
CHARACTER(3) :: S1,S2,S3,S4,S5,S6

CALL POINT_TO_MESH(NM)

SELECT CASE (PERIODIC_TEST)
   CASE(2,9)
      IMIN=1
      JMIN=1
      KMIN=1
   CASE DEFAULT
      IMIN=0
      JMIN=0
      KMIN=0
END SELECT
IMAX = IBAR
JMAX = JBAR
KMAX = KBAR

LU_UVW = GET_FILE_NUMBER()
OPEN(UNIT=LU_UVW,FILE=TRIM(FN_UVW),FORM='FORMATTED',STATUS='UNKNOWN')

WRITE(S1,'(I3)') IMIN; S1 = ADJUSTL(S1)
WRITE(S2,'(I3)') IMAX; S2 = ADJUSTL(S2)
WRITE(S3,'(I3)') JMIN; S3 = ADJUSTL(S3)
WRITE(S4,'(I3)') JMAX; S4 = ADJUSTL(S4)
WRITE(S5,'(I3)') KMIN; S5 = ADJUSTL(S5)
WRITE(S6,'(I3)') KMAX; S6 = ADJUSTL(S6)

WRITE(LU_UVW,'(A)') TRIM(S1)//','//TRIM(S2)//','//TRIM(S3)//','//TRIM(S4)//','//TRIM(S5)//','//TRIM(S6)

DO K=KMIN,KMAX
   DO J=JMIN,JMAX
      DO I=IMIN,IMAX
         WRITE(LU_UVW,'(E22.15,A,E22.15,A,E22.15)') U(I,J,K),',',V(I,J,K),',',W(I,J,K)
      ENDDO
   ENDDO
ENDDO

CLOSE(LU_UVW)

END SUBROUTINE DUMP_UVW


SUBROUTINE DUMP_MMS(NM,FN_MMS,T)

! Dump MMS file (manufactured solution raw data)

USE COMP_FUNCTIONS, ONLY: GET_FILE_NUMBER
INTEGER  :: I,J,K,LU_MMS,IMIN,JMIN,KMIN,IMAX,JMAX,KMAX
INTEGER, INTENT(IN) :: NM
REAL(EB), INTENT(IN) :: T
CHARACTER(80), INTENT(IN) :: FN_MMS
CHARACTER(4) :: S1,S2,S3,S4,S5,S6

CALL POINT_TO_MESH(NM)

IMIN=1
JMIN=1
KMIN=1
IMAX=IBAR
JMAX=JBAR
KMAX=KBAR

LU_MMS = GET_FILE_NUMBER()
OPEN(UNIT=LU_MMS,FILE=TRIM(FN_MMS),FORM='FORMATTED',STATUS='UNKNOWN')

WRITE(S1,'(I4)') IMIN; S1 = ADJUSTL(S1)
WRITE(S2,'(I4)') IMAX; S2 = ADJUSTL(S2)
WRITE(S3,'(I4)') JMIN; S3 = ADJUSTL(S3)
WRITE(S4,'(I4)') JMAX; S4 = ADJUSTL(S4)
WRITE(S5,'(I4)') KMIN; S5 = ADJUSTL(S5)
WRITE(S6,'(I4)') KMAX; S6 = ADJUSTL(S6)

WRITE(LU_MMS,'(A)') TRIM(S1)//','//TRIM(S2)//','//TRIM(S3)//','//TRIM(S4)//','//TRIM(S5)//','//TRIM(S6)
WRITE(LU_MMS,'(E22.15)') T

DO K=KMIN,KMAX
   DO J=JMIN,JMAX
      DO I=IMIN,IMAX
         WRITE(LU_MMS,'(E22.15,A,E22.15,A,E22.15,A,E22.15,A,E22.15)') &
            RHO(I,J,K),',',ZZ(I,J,K,2),',',U(I,J,K),',',W(I,J,K),',',H(I,J,K)
      ENDDO
   ENDDO
ENDDO

CLOSE(LU_MMS)

END SUBROUTINE DUMP_MMS


SUBROUTINE EXTRAPOLATE_EXTREMA

! Given DV%N_INTERVALS values of DV%TIME_MIN(MAX)_VALUE, extrapolate the MIN(MAX) for the DV%TIME_PERIOD, which is typically
! longer than the statistical sampling duration DV%STATISTICS_END-DV%STATISTICS_START

REAL(EB), ALLOCATABLE, DIMENSION(:) :: EXTREMA,YYY
INTEGER :: I,J
REAL(EB) :: A,B,X_AVG,Y_AVG,TT,ST2,INTERVAL_RATIO,F

ALLOCATE(EXTREMA(DV%N_INTERVALS))
ALLOCATE(YYY(DV%N_INTERVALS))

IF (DV%TEMPORAL_STATISTIC=='MAX') THEN
   EXTREMA = DV%TIME_MAX_VALUE
ELSE
   EXTREMA = -DV%TIME_MIN_VALUE
ENDIF

! Sort EXTREMA in increasing order

DO J=2,DV%N_INTERVALS
   A = EXTREMA(J)
   DO I=J-1,1,-1
      IF (EXTREMA(I)<=A) THEN
         EXTREMA(I+1) = A
         EXIT
      ENDIF
      EXTREMA(I+1) = EXTREMA(I)
      IF (I==1) EXTREMA(1) = A
   ENDDO
ENDDO

DO I=1,DV%N_INTERVALS
   F = REAL(I,EB)/REAL(DV%N_INTERVALS+1,EB)  ! Probability of NOT exceeding the EXTREMA during the time interval
   YYY(I) = LOG(-LOG(1._EB-F))
ENDDO

! Determine line YYY = A*EXTREMA + B

X_AVG = SUM(EXTREMA(1:DV%N_INTERVALS))/REAL(DV%N_INTERVALS,EB)
Y_AVG = SUM(YYY(1:DV%N_INTERVALS))/REAL(DV%N_INTERVALS,EB)
ST2 = 0._EB
A  = 0._EB
DO I=1,DV%N_INTERVALS
   TT = EXTREMA(I) - X_AVG
   ST2 = ST2 + TT**2
   A = A + TT*YYY(I)
ENDDO
A = A/ST2
B = (Y_AVG-X_AVG*A)

INTERVAL_RATIO = (DV%STATISTICS_END-DV%STATISTICS_START)/REAL(DV%N_INTERVALS)/DV%TIME_PERIOD
DV%VALUE = (LOG(-LOG(INTERVAL_RATIO)) - B)/A
IF (DV%TEMPORAL_STATISTIC=='MIN') DV%VALUE = -DV%VALUE
DV%STATISTICS_END = -1.E20_EB

DEALLOCATE(EXTREMA)
DEALLOCATE(YYY)

END SUBROUTINE EXTRAPOLATE_EXTREMA

END MODULE DUMP
